From 1428729afd3b6c13e78fcfa4e09070502acae31c Mon Sep 17 00:00:00 2001 From: mattias Date: Fri, 27 Dec 2002 17:54:54 +0000 Subject: [PATCH] added htmllite git-svn-id: trunk@3744 - --- .gitattributes | 12 + components/htmllite/dclLVw3.dpk | 45 + components/htmllite/dclLVw4.dpk | 45 + components/htmllite/dclLVw5.dpk | 47 + components/htmllite/dclLVw6.dpk | 47 + components/htmllite/dclLVw7.dpk | 48 + components/htmllite/html32.res | Bin 0 -> 2740 bytes components/htmllite/htmllite.dcr | Bin 0 -> 472 bytes components/htmllite/htmllite.pas | 2983 ++++++++++++++ components/htmllite/litecons.inc | 91 + components/htmllite/litedith.pas | 1745 ++++++++ components/htmllite/litedith.rst | 28 + components/htmllite/litegif1.pas | 2053 ++++++++++ components/htmllite/litegif2.pas | 641 +++ components/htmllite/litepars.pas | 2573 ++++++++++++ components/htmllite/litereadthd.pas | 86 + components/htmllite/litesbs1.pas | 738 ++++ components/htmllite/litesubs.pas | 5900 +++++++++++++++++++++++++++ components/htmllite/liteun2.pas | 2194 ++++++++++ 19 files changed, 19276 insertions(+) create mode 100644 components/htmllite/dclLVw3.dpk create mode 100644 components/htmllite/dclLVw4.dpk create mode 100644 components/htmllite/dclLVw5.dpk create mode 100644 components/htmllite/dclLVw6.dpk create mode 100644 components/htmllite/dclLVw7.dpk create mode 100644 components/htmllite/html32.res create mode 100644 components/htmllite/htmllite.dcr create mode 100644 components/htmllite/htmllite.pas create mode 100644 components/htmllite/litecons.inc create mode 100644 components/htmllite/litedith.pas create mode 100644 components/htmllite/litedith.rst create mode 100644 components/htmllite/litegif1.pas create mode 100644 components/htmllite/litegif2.pas create mode 100644 components/htmllite/litepars.pas create mode 100644 components/htmllite/litereadthd.pas create mode 100644 components/htmllite/litesbs1.pas create mode 100644 components/htmllite/litesubs.pas create mode 100644 components/htmllite/liteun2.pas diff --git a/.gitattributes b/.gitattributes index 63472590bf..dd255ed906 100644 --- a/.gitattributes +++ b/.gitattributes @@ -44,6 +44,18 @@ components/gtk/gtkglarea/gtkopengl.pas svneol=native#text/pascal components/gtk/gtkglarea/nvgl.pp svneol=native#text/pascal components/gtk/gtkglarea/nvglx.pp svneol=native#text/pascal components/gtk/gtkglarea/tgtkglareacontrol.xpm -text svneol=native#image/x-xpixmap +components/htmllite/html32.res svneol=native#unset +components/htmllite/htmllite.dcr -text svneol=native#application/x-director +components/htmllite/htmllite.pas svneol=native#text/pascal +components/htmllite/litecons.inc svneol=native#text/pascal +components/htmllite/litedith.pas svneol=native#text/pascal +components/htmllite/litegif1.pas svneol=native#text/pascal +components/htmllite/litegif2.pas svneol=native#text/pascal +components/htmllite/litepars.pas svneol=native#text/pascal +components/htmllite/litereadthd.pas svneol=native#text/pascal +components/htmllite/litesbs1.pas svneol=native#text/pascal +components/htmllite/litesubs.pas svneol=native#text/pascal +components/htmllite/liteun2.pas svneol=native#text/pascal components/synedit/allunits.pp svneol=native#text/pascal components/synedit/languages/synedit.de.po svneol=native#text/plain components/synedit/languages/synedit.po svneol=native#text/plain diff --git a/components/htmllite/dclLVw3.dpk b/components/htmllite/dclLVw3.dpk new file mode 100644 index 0000000000..208a28a6ae --- /dev/null +++ b/components/htmllite/dclLVw3.dpk @@ -0,0 +1,45 @@ +package dclLVw3; + +{$R *.RES} +{$R 'htmllite.dcr'} +{$ALIGN ON} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESIGNONLY} +{$IMPLICITBUILD ON} + +requires + vcl30; + +contains + LiteUn2, + LitePars, + LiteSbs1, + LiteSubs, + HTMLLite, + jpeg, + jconsts, + LiteDith, + LiteReadThd, + litegif2, + litegif1; + +end. diff --git a/components/htmllite/dclLVw4.dpk b/components/htmllite/dclLVw4.dpk new file mode 100644 index 0000000000..e56220140c --- /dev/null +++ b/components/htmllite/dclLVw4.dpk @@ -0,0 +1,45 @@ +package dclLVw4; + +{$R *.RES} +{$R 'htmllite.dcr'} +{$ALIGN ON} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $00400000} +{$DESCRIPTION 'ThtmlLite'} +{$DESIGNONLY} +{$IMPLICITBUILD OFF} + +requires + vcl40, + VCLJPG40; + +contains + LiteUn2 in 'LiteUn2.pas', + LitePars in 'LitePars.pas', + LiteSbs1 in 'LiteSbs1.pas', + LiteSubs in 'LiteSubs.pas', + HTMLLite in 'HTMLLite.pas', + LiteDith in 'LiteDith.pas', + LiteReadThd in 'LiteReadThd.pas', + litegif1 in 'litegif1.pas', + litegif2 in 'litegif2.pas'; + +end. diff --git a/components/htmllite/dclLVw5.dpk b/components/htmllite/dclLVw5.dpk new file mode 100644 index 0000000000..1933346d41 --- /dev/null +++ b/components/htmllite/dclLVw5.dpk @@ -0,0 +1,47 @@ +package dclLVw5; + +{$R *.RES} +{$R 'htmllite.dcr'} +{$ALIGN OFF} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA OFF} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'ThtmlLite'} +{$DESIGNONLY} +{$IMPLICITBUILD ON} + +requires + vcl50, + VCLJPG50; + +{%File 'LiteCons.inc'} + +contains + HTMLLite in 'HTMLLite.pas', + LiteUn2 in 'LiteUn2.pas', + LitePars in 'LitePars.pas', + LiteSbs1 in 'LiteSbs1.pas', + LiteSubs in 'LiteSubs.pas', + LiteDith in 'LiteDith.pas', + litegif1 in 'litegif1.pas', + litegif2 in 'litegif2.pas', + LiteReadThd in 'LiteReadThd.pas'; + +end. diff --git a/components/htmllite/dclLVw6.dpk b/components/htmllite/dclLVw6.dpk new file mode 100644 index 0000000000..0f3da36e67 --- /dev/null +++ b/components/htmllite/dclLVw6.dpk @@ -0,0 +1,47 @@ +package dclLVw6; + +{$R *.res} +{$R 'htmllite.dcr'} +{$ALIGN 1} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA OFF} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'ThtmlLite'} +{$DESIGNONLY} +{$IMPLICITBUILD ON} + +requires + vcl, + vcljpg; + +{%File 'LiteCons.inc'} + +contains + HTMLLite in 'HTMLLite.pas', + LiteUn2 in 'LiteUn2.pas', + LitePars in 'LitePars.pas', + LiteSbs1 in 'LiteSbs1.pas', + LiteSubs in 'LiteSubs.pas', + LiteDith in 'LiteDith.pas', + LiteReadThd in 'LiteReadThd.pas', + litegif2 in 'litegif2.pas', + litegif1 in 'litegif1.pas'; + +end. diff --git a/components/htmllite/dclLVw7.dpk b/components/htmllite/dclLVw7.dpk new file mode 100644 index 0000000000..687bc31c61 --- /dev/null +++ b/components/htmllite/dclLVw7.dpk @@ -0,0 +1,48 @@ +package dclLVw7; + +{$R *.res} +{$R 'htmllite.dcr'} +{$ALIGN 1} +{$ASSERTIONS OFF} +{$BOOLEVAL OFF} +{$DEBUGINFO OFF} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA OFF} +{$IOCHECKS ON} +{$LOCALSYMBOLS OFF} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS OFF} +{$REFERENCEINFO OFF} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'ThtmlLite'} +{$DESIGNONLY} +{$IMPLICITBUILD ON} + +requires + vcl, + vcljpg, + rtl; + +{%File 'LiteCons.inc'} + +contains + HTMLLite in 'HTMLLite.pas', + LiteUn2 in 'LiteUn2.pas', + LitePars in 'LitePars.pas', + LiteSbs1 in 'LiteSbs1.pas', + LiteSubs in 'LiteSubs.pas', + LiteDith in 'LiteDith.pas', + LiteReadThd in 'LiteReadThd.pas', + litegif2 in 'litegif2.pas', + litegif1 in 'litegif1.pas'; + +end. diff --git a/components/htmllite/html32.res b/components/htmllite/html32.res new file mode 100644 index 0000000000000000000000000000000000000000..74c1494ca9542535e64709fc35ae3ca653afc887 GIT binary patch literal 2740 zcmd5;y=ogl5S}~9zcENf%7Cs+X*d-r1QuvP1dJUVOvpooq`UI2P;rn#uaYVR)EqeF zJ%rLFF$n>?xFTrs&2Cn@J?Ru%A|YeX&hG5&?CiHYqaz{;z|4lxb*Ssvc@H+eo@=)k zCM{~wV+;duAMD{zDADb5!?IDCyoAW_6Ey>(eK>CK!&#Fko{>XkJF)fq*esz<2r(>Z z7Bl}mVJ6{#4fYNUWvsTv zRPI6UL+(X<6`hsXyO<(gP#M!hI@s==YLAts18h#ff|2lR@T>QR4aImd%zwY2x|7c1i>9Gxq zj}omv@!y|yG2PXXxtOl5r({ZR=_IC$h?jJCQb_Ie`zD`ja$3LXy4*Kqo`g0+tz09D z&dQwDHMlPKXNz4wBZff7;UktWx}dh(2c`%>FK<+SvV=V{>ID7Oln~*clEetK=u(zt zkTM}Zlp@#&v?k#oixf0wemenu;9@d)_h2#^LlPNj$6_FQE3LjN?YgSec6J}TuZzQ1 zjl(fQwe-($z|}-CGmwZPbW*-mDvCHADNq!rN_CYQYWYzOqmdef`RTyOT+3d56~@r# zB2$^qhn%V~%&*SjCk%T7<}@9374R0+K~|36;J^V`zE_yP{Q(E_ko&M-MK}sg_i+F4 zlECynENf)#Lpbh%nU6@(IlZ7Wv}bfmFKIxRbV1KCzL;-+EDv=~KHhAAZ!7t-lIr1W re@`$k{x0d++~@s$HI{sB9@nn+75t8i`P$&V_AJfHn(ud5vqQfCN$QMj literal 0 HcmV?d00001 diff --git a/components/htmllite/htmllite.dcr b/components/htmllite/htmllite.dcr new file mode 100644 index 0000000000000000000000000000000000000000..8294135e0d053e920b24712bbe7bd9b854469f1d GIT binary patch literal 472 zcmb`CI}QRd3`A!U4IL%rmXs^y3PAz|Iu4YQ1Eq75o0)OEOIQhs0w$UG+4%#&NUOSu zD?J8aVnua>JI?eCSGEi3G_Rbn+b)}qgv0CsULJYIyY{an1MJAz14klit&BEdkFua1 tIQlyk;ZKsT&{2XUNu@M5PTx36>T9CJ5({(NYhC06xBIN#wc=mC_yj?smVN*L literal 0 HcmV?d00001 diff --git a/components/htmllite/htmllite.pas b/components/htmllite/htmllite.pas new file mode 100644 index 0000000000..5504c96388 --- /dev/null +++ b/components/htmllite/htmllite.pas @@ -0,0 +1,2983 @@ +{Version 7.5} +{*********************************************************} +{* HTMLLITE.PAS *} +{* Copyright (c) 1995-2002 by *} +{* L. David Baldwin *} +{* All rights reserved. *} +{*********************************************************} + +{$DEFINE HL_LAZARUS} + +{$i LiteCons.inc} + +unit HTMLLite; + +interface + +{$IFDEF HL_LAZARUS} +uses + Classes, SysUtils, LCLLinux, LMessages, Messages, LCLType, VCLGlobals, + GraphType, Graphics, Controls, StdCtrls, Forms, Dialogs, ExtCtrls, Menus, + Clipbrd, LiteUn2, LiteSubs, LiteSbs1, LitePars, LiteReadThd; +{$ELSE not HL_LAZARUS} +uses + SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, StdCtrls, + LiteUn2, Forms, Dialogs, ExtCtrls, LitePars, LiteSubs, LiteReadThd, Menus, + Clipbrd; +{$ENDIF not HL_LAZARUS} + +const + wm_FormSubmit = wm_User+100; + wm_MouseScroll = wm_User+102; + wm_Suspend = wm_User+103; + wm_Terminate = wm_User+104; + + +type + THTMLBorderStyle = (htFocused, htNone, htSingle); + TRightClickParameters = Class(TObject) + URL, Target: string; + Image: TImageObj; + ImageX, ImageY: integer; + ClickWord: string; + end; + TRightClickEvent = procedure(Sender: TObject; Parameters: TRightClickParameters) of Object; + THotSpotEvent = procedure(Sender: TObject; const SRC: string) of Object; + THotSpotClickEvent = procedure(Sender: TObject; const SRC: string; + var Handled: boolean) of Object; + TProcessingEvent = procedure(Sender: TObject; ProcessingOn: boolean) of Object; + TImageClickEvent = procedure(Sender, Obj: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer) of Object; + TImageOverEvent = procedure(Sender, Obj: TObject; Shift: TShiftState; + X, Y: Integer) of Object; + TMetaRefreshType = procedure(Sender: TObject; Delay: integer; const URL: string) of Object; + + htOptionEnum = (htOverLinksActive,htNoLinkUnderline, htShowDummyCaret, htShowVScroll); + ThtmlViewerOptions = set of htOptionEnum; + + TPaintPanel = class(TCustomPanel) + private + FOnPaint: TNotifyEvent; + FViewer: TComponent; + Canvas2: TCanvas; + procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_EraseBkgnd; + procedure WMLButtonDblClk(var Message: TWMMouse); message WM_LButtonDblClk; + procedure DoBackground(ACanvas: TCanvas; WmErase: boolean); + constructor CreateIt(AOwner: TComponent; Viewer: TComponent); + property OnPaint: TNotifyEvent read FOnPaint write FOnPaint; + public + procedure Paint; override; + end; + + T32ScrollBar = Class(TScrollBar) {a 32 bit scrollbar} + private + FPosition: integer; + FMin, FMax, FPage: integer; + procedure SetPosition(Value: integer); + procedure SetMin(Value: Integer); + procedure SetMax(Value: Integer); + procedure CNVScroll(var Message: TWMVScroll); message CN_VSCROLL; + public + property Position: integer read FPosition write SetPosition; + property Min: integer read FMin write SetMin; + property Max: integer read FMax write SetMax; + procedure SetParams(APosition, APage, AMin, AMax: Integer); + end; + + ThtmlFileType = (HTMLType, TextType, ImgType, OtherType); + + ThtmlLite = class(TWinControl) + private + ParseThreadHasTerminated: boolean; + SuspendException: boolean; + FProcessingOnAtSuspend: boolean; + FParseBatch: integer; {number of chars parsed before suspend} + procedure ParserTerminate(Sender: TObject); + procedure AppendStr(const S: string; ViewBottom, Finish, + ProcessOn: boolean); + function AppendBatch(const St: string): string; + protected + hlParser: ThlParser; + FOnDragDrop: TDragDropEvent; + FOnDragOver: TDragOverEvent; + OldHeight, OldWidth, OldCount, OldCharPos: integer; + function GetDragDrop: TDragDropEvent; + function GetDragOver: TDragOverEvent; + procedure SetDragDrop(const Value: TDragDropEvent); + procedure SetDragOver(const Value: TDragOverEvent); + procedure HTMLDragDrop(Sender, Source: TObject; X, Y: Integer); + procedure HTMLDragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); + protected + { Private declarations } + DontDraw: boolean; + FTitle: String; + FURL: String; + FTarget: String; + FBase, FBaseEx: String; + FBaseTarget: String; + FCurrentFile: String; + FNameList: TStringList; + FCurrentFileType: ThtmlFileType; + FOnHotSpotCovered: THotSpotEvent; + FOnHotSpotClick: THotSpotClickEvent; + FOnImageRequest: TGetImageEvent; + FOnScript: TScriptEvent; + FOnFormSubmit: TFormSubmitEvent; + FOnHistoryChange: TNotifyEvent; + FOnProcessing: TProcessingEvent; + FOnInclude: TIncludeType; + FOnSoundRequest: TSoundType; + FOnMeta: TMetaType; + FOnMetaRefresh: TMetaRefreshType; + FRefreshURL: string; + FRefreshDelay: Integer; + FOnRightClick: TRightClickEvent; + FOnImageClick: TImageClickEvent; + FOnImageOver: TImageOverEvent; + FOnObjectClick: TObjectClickEvent; + FHistory, FTitleHistory: TStrings; + FPositionHistory: TFreeList; + FHistoryIndex: integer; + FHistoryMaxCount: integer; + FFontName: String; + FPreFontName: String; + FFontColor: TColor; + FHotSpotColor, FVisitedColor, FOverColor: TColor; + FVisitedMaxCount: integer; + FBackGround: TColor; + FFontSize: integer; + FProcessing: boolean; + FAction, FFormTarget, FEncType, FMethod: String; + FStringList: TStringList; + FImageCacheCount: integer; + FNoSelect: boolean; + FScrollBars: TScrollStyle; + FBorderStyle: THTMLBorderStyle; + FDither: boolean; + FCaretPos: integer; + FOptions: ThtmlViewerOptions; + sbWidth: integer; + ScrollWidth: integer; + MaxVertical: integer; + MouseScrolling: boolean; + LeftButtonDown: boolean; + MiddleScrollOn: boolean; + MiddleY: integer; + Hiliting: boolean; + {$ifdef ver100_plus} {Delphi 3,4,5, C++Builder 3, 4} + FCharset: TFontCharset; + {$endif} + FPage: integer; + FOnMouseDouble: TMouseEvent; + HotSpotAction: boolean; + FMarginHeight, FMarginWidth: integer; + FServerRoot: string; + FSectionList: TSectionList; + FImageStream: TMemoryStream; + FOnExpandName: TExpandNameEvent; + FViewBottom: boolean; + HTMLTimer: TTimer; + + procedure WMSize(var Message: TWMSize); message WM_SIZE; + procedure ScrollTo(Y: integer); + procedure Scroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); + procedure Layout; + procedure SetViewImages(Value: boolean); + function GetViewImages: boolean; + procedure SetColor(Value: TColor); + function GetBase: string; + procedure SetBase(Value: string); + function GetBaseTarget: string; + function GetFURL: string; + function GetTitle: string; + function GetCurrentFile: string; + procedure SetBorderStyle(Value: THTMLBorderStyle); + function GetPosition: integer; + procedure SetPosition(Value: integer); + function GetScrollPos: integer; + procedure SetScrollPos(Value: integer); + function GetScrollBarRange: integer; + procedure SetHistoryIndex(Value: integer); + function GetFontName: TFontName; + procedure SetFontName(Value: TFontName); + function GetPreFontName: TFontName; + procedure SetPreFontName(Value: TFontName); + procedure SetFontSize(Value: integer); + procedure SetFontColor(Value: TColor); + procedure SetHotSpotColor(Value: TColor); + procedure SetActiveColor(Value: TColor); + procedure SetVisitedColor(Value: TColor); + procedure SetVisitedMaxCount(Value: integer); + procedure SetOnImageRequest(Handler: TGetImageEvent); + procedure SetOnScript(Handler: TScriptEvent); + procedure SetOnFormSubmit(Handler: TFormSubmitEvent); + function GetOurPalette: HPalette; + procedure SetOurPalette(Value: HPalette); + procedure SetDither(Value: boolean); + procedure SetCaretPos(Value: integer); + procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE; + procedure BackgroundChange(Sender: TObject); + procedure SubmitForm(Sender: TObject; + const Action, TheTarget, EncType, Method: string; Results: TStringList); + procedure SetImageCacheCount(Value: integer); + procedure WMFormSubmit(var Message: TMessage); message WM_FormSubmit; + procedure WMMouseScroll(var Message: TMessage); message WM_MouseScroll; + procedure WMSuspend(var Message: TMessage); message WM_Suspend; + procedure WMTerminate(var Message: TMessage); message WM_Terminate; + procedure SetSelLength(Value: integer); + procedure SetSelStart(Value: integer); + function GetSelLength: integer; + function GetSelText: string; + procedure SetNoSelect(Value: boolean); + procedure SetHistoryMaxCount(Value: integer); + procedure DrawBorder; + procedure DoHilite(X, Y: integer); + procedure SetScrollBars(Value: TScrollStyle); + procedure SetProcessing(Value: boolean); + function GetTarget: String; + {$ifdef ver100_plus} {Delphi 3,4,5, C++Builder 3, 4} + procedure SetCharset(Value: TFontCharset); + {$endif} + function GetFormControlList: TList; + function GetNameList: TStringList; + function GetLinkList: TList; + procedure SetMarginWidth(Value: integer); + procedure SetMarginHeight(Value: integer); + procedure SetServerRoot(Value: string); + procedure SetOnObjectClick(Handler: TObjectClickEvent); + procedure FormControlEnterEvent(Sender: TObject); + procedure HandleMeta(Sender: TObject; const HttpEq, + {$IFDEF HL_LAZARUS}NewName{$ELSE}Name{$ENDIF}, Content: string); + procedure SetOptions(Value: ThtmlViewerOptions); + procedure SetOnExpandName(Handler: TExpandNameEvent); + function GetWordAtCursor(X, Y: integer; var St, En: integer; + var AWord: string): boolean; + procedure HTMLTimerTimer(Sender: TObject); + procedure InitLoad; + + protected + { Protected declarations } + PaintPanel: TPaintPanel; + BorderPanel: TPanel; + VScrollBar: T32ScrollBar; + HScrollBar: TScrollBar; + Sel1: integer; + Visited: TStringList; {visited URLs} + ParseThread: TParseThread; + + procedure DoLogic(StartY, StartScroll, StartCount, StartCharPos: integer); + procedure DoScrollBars; + procedure SetupAndLogic(StartY, StartScroll, StartCount, StartCharPos: integer); + function GetURL(X, Y: integer; var UrlTarg: TUrlTarget; + var FormControl: TImageFormControlObj): boolean; + procedure KeyDown(var Key: Word; Shift: TShiftState); override; + function GetPalette: HPALETTE; override; + procedure HTMLPaint(Sender: TObject); virtual; + procedure HTMLMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); virtual; +{$ifdef ver120_plus} + procedure HTMLMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +{$endif} + procedure HTMLMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); virtual; + procedure HTMLMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); virtual; + procedure HTMLMouseDblClk(Message: TWMMouse); + procedure URLAction; virtual; + function HotSpotClickHandled: boolean; dynamic; + procedure LoadFile(const FileName: string; ft: ThtmlFileType); + procedure LoadString(const Source, Reference: string; ft: ThtmlFileType); + procedure PaintWindow(DC: HDC); override; + procedure UpdateImageCache; + procedure AddVisitedLink(const S: string); + procedure CheckVisitedLinks; + {$IFDEF HL_LAZARUS} + procedure InitializeWnd; override; + {$ENDIF} + public + { Public declarations } + FrameOwner: TObject; + FMarginHeightX, FMarginWidthX: integer; + + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + function HTMLExpandFilename(const Filename: string): string; virtual; + procedure LoadFromFile(const FileName: string); + procedure LoadTextFile(const FileName: string); + procedure LoadImageFile(const FileName: string); + procedure LoadStrings(const Strings: TStrings; const Reference: string); + procedure LoadTextStrings(const Strings: TStrings); + procedure LoadFromString(const S, Reference: string); + procedure LoadTextFromString(const S: string); + procedure LoadFromStream(const AStream: TStream; const Reference: string); + function PositionTo(Dest: string): boolean; + function Find(const S: String; MatchCase: boolean): boolean; + procedure Clear; virtual; + procedure CopyToClipboard; + procedure SelectAll; + procedure ClearHistory; + procedure Reload; + procedure BumpHistory(const FileName, Title: string; + OldPos: integer; ft: ThtmlFileType); + function GetSelTextBuf(Buffer: PChar; BufSize: integer): integer; + function InsertImage(const Src: string; Stream: TMemoryStream): boolean; + procedure DoEnter; override; + procedure DoExit; override; + procedure Repaint; override; + function FindSourcePos(DisplayPos: integer): integer; + function FindDisplayPos(SourcePos: integer; Prev: boolean): integer; + function DisplayPosToXy(DisplayPos: integer; var X, Y: integer): boolean; + function PtInObject(X, Y: integer; var Obj: TObject): boolean; {X, Y, are client coord} + procedure SignalSuspend; + procedure InitStr(ft: ThtmlFileType); + procedure InitiateAppend(Ref: string); + procedure AppendString(const S: string; ViewBottom, Finish: boolean); + + property DocumentTitle: string read GetTitle; + property URL: string read GetFURL; + property Base: string read GetBase write SetBase; + property BaseTarget: string read GetBaseTarget; + property Position: integer read GetPosition write SetPosition; + property VScrollBarPosition: integer read GetScrollPos write SetScrollPos; + property VScrollBarRange: integer read GetScrollBarRange; + property CurrentFile: string read GetCurrentFile; + property History: TStrings read FHistory; + property TitleHistory: TStrings read FTitleHistory; + property HistoryIndex: integer read FHistoryIndex write SetHistoryIndex; + property Processing: boolean read FProcessing; + property SelStart: integer read FCaretPos write SetSelStart; + property SelLength: integer read GetSelLength write SetSelLength; + property SelText: string read GetSelText; + property Target: string read GetTarget; + property Palette: HPalette read GetOurPalette write SetOurPalette; + property Dither: boolean read FDither write SetDither default True; + property CaretPos: integer read FCaretPos write SetCaretPos; + property FormControlList: TList read GetFormControlList; + property NameList: TStringList read GetNameList; + property LinkList: TList read GetLinkList; + property SectionList: TSectionList read FSectionList; + property OnExpandName: TExpandNameEvent read FOnExpandName write SetOnExpandName; + + published + { Published declarations } + property OnHotSpotCovered: THotSpotEvent read FOnHotSpotCovered + write FOnHotSpotCovered; + property OnHotSpotClick: THotSpotClickEvent read FOnHotSpotClick + write FOnHotSpotClick; + property OnImageRequest: TGetImageEvent read FOnImageRequest + write SetOnImageRequest; + property OnScript: TScriptEvent read FOnScript + write SetOnScript; + property OnFormSubmit: TFormSubmitEvent read FOnFormSubmit + write SetOnFormSubmit; + property OnHistoryChange: TNotifyEvent read FOnHistoryChange + write FOnHistoryChange; + property ViewImages: boolean read GetViewImages write SetViewImages default True; + property Enabled; + property TabStop; + property TabOrder; + property Align; + property Name; + property Tag; + property PopupMenu; + property ShowHint; + property Height default 150; + property Width default 150; + property DefBackground: TColor read FBackground write SetColor default clBtnFace; + property BorderStyle: THTMLBorderStyle read FBorderStyle write SetBorderStyle; + property Visible; + property HistoryMaxCount: integer read FHistoryMaxCount write SetHistoryMaxCount; + property DefFontName: TFontName read GetFontName write SetFontName; + property DefPreFontName: TFontName read GetPreFontName write SetPreFontName; + property DefFontSize: integer read FFontSize write SetFontSize default 12; + property DefFontColor: TColor read FFontColor write SetFontColor + default clBtnText; + property DefHotSpotColor: TColor read FHotSpotColor write SetHotSpotColor + default clBlue; + property DefVisitedLinkColor: TColor read FVisitedColor write SetVisitedColor + default clPurple; + property DefOverLinkColor: TColor read FOverColor write SetActiveColor + default clBlue; + property VisitedMaxCount: integer read FVisitedMaxCount write SetVisitedMaxCount default 50; + property ImageCacheCount: integer read FImageCacheCount + write SetImageCacheCount default 5; + property NoSelect: boolean read FNoSelect write SetNoSelect; + property ScrollBars: TScrollStyle read FScrollBars write SetScrollBars default ssBoth; + {$ifdef ver100_plus} {Delphi 3,4,5, C++Builder 3, 4} + property CharSet: TFontCharset read FCharSet write SetCharset; + {$endif} + property MarginHeight: integer read FMarginHeight write SetMarginHeight default 5; + property MarginWidth: integer read FMarginWidth write SetMarginWidth default 10; + property ServerRoot: string read FServerRoot write SetServerRoot; + property htOptions: ThtmlViewerOptions read FOptions write SetOptions; + + property OnMouseMove; + property OnMouseUp; + property OnMouseDown; + property OnKeyDown; + property OnKeyUp; + property OnKeyPress; + property OnEnter; + property OnProcessing: TProcessingEvent read FOnProcessing write FOnProcessing; + property OnInclude: TIncludeType read FOnInclude write FOnInclude; + property OnSoundRequest: TSoundType read FOnSoundRequest write FOnSoundRequest; + property OnMeta: TMetaType read FOnMeta write FOnMeta; + property OnMetaRefresh: TMetaRefreshType read FOnMetaRefresh write FOnMetaRefresh; + property OnImageClick: TImageClickEvent read FOnImageClick write FOnImageClick; + property OnImageOver: TImageOverEvent read FOnImageOver write FOnImageOver; + property OnObjectClick: TObjectClickEvent read FOnObjectClick write SetOnObjectClick; + property OnRightClick: TRightClickEvent read FOnRightClick write FOnRightClick; + property OnMouseDouble: TMouseEvent read FOnMouseDouble write FOnMouseDouble; + property OnDragDrop: TDragDropEvent read GetDragDrop write SetDragDrop; + property OnDragOver: TDragOverEvent read GetDragOver write SetDragOver; + property ParseBatch: integer read FParseBatch write FParseBatch; + end; + + +procedure Register; + +implementation + +const + MaxHScroll = 6000; {max horizontal display in pixels} + VScale = 1; + ScrollGap = 20; + +type + PositionObj = class(TObject) + Pos: integer; + FileType: ThtmlFileType; + end; + +constructor ThtmlLite.Create(AOwner: TComponent); +begin +inherited Create(AOwner); +ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents, + csSetCaption, csDoubleClicks]; +Height := 150; +Width := 150; +{$ifdef ver100_plus} {Delphi 3,4,5, C++Builder 3, 4} +FCharset := DEFAULT_CHARSET; +{$endif} +FMarginHeight := 5; +FMarginWidth := 10; + +hlParser := ThlParser.Create; + +BorderPanel := TPanel.Create(Self); +BorderPanel.BevelInner := bvNone; +BorderPanel.BevelOuter := bvNone; +BorderPanel.Ctl3D := False; +BorderPanel.ParentColor := True; +BorderPanel.Align := alClient; +BorderPanel.ParentCtl3D := False; + +InsertControl(BorderPanel); + +PaintPanel := TPaintPanel.CreateIt(Self, Self); +PaintPanel.ParentFont := False; +InsertControl(PaintPanel); +PaintPanel.Top := 1; +PaintPanel.Left := 1; +PaintPanel.BevelOuter := bvNone; +PaintPanel.BevelInner := bvNone; +PaintPanel.ctl3D := False; +PaintPanel.ParentColor := True; + +PaintPanel.OnPaint := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLPaint; +PaintPanel.OnMouseDown := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLMouseDown; +PaintPanel.OnMouseMove := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLMouseMove; +PaintPanel.OnMouseUp := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLMouseUp; +{$ifdef ver120_plus} +OnMouseWheel := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLMouseWheel; +{$endif} + +VScrollBar := T32ScrollBar.Create(Self); +VScrollBar.Kind := sbVertical; +VScrollBar.SmallChange := 16; +VScrollBar.Visible := False; +VScrollBar.TabStop := False; +sbWidth := VScrollBar.Width; +InsertControl(VScrollBar); + +HScrollBar := TScrollBar.Create(Self); +HScrollBar.Kind := sbHorizontal; +HScrollBar.SmallChange := 15; +HScrollBar.OnScroll := {$IFDEF HL_LAZARUS}@{$ENDIF}Scroll; +HScrollBar.Visible := False; +HScrollBar.TabStop := False; +InsertControl(HScrollBar); + +FScrollBars := ssBoth; + +FSectionList := TSectionList.Create(Self, PaintPanel); +FSectionList.ControlEnterEvent := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlEnterEvent; +FSectionList.OnBackgroundChange := {$IFDEF HL_LAZARUS}@{$ENDIF}BackgroundChange; +FSectionList.ShowImages := True; +FSectionList.Parser := hlParser; + +FNameList := TStringList.Create; +FNameList.Sorted := True; +DefBackground := clBtnFace; +DefFontColor := clBtnText; +DefHotSpotColor := clBlue; +DefOverLinkColor := clBlue; +DefVisitedLinkColor := clPurple; +FVisitedMaxCount := 50; +DefFontSize := 12; +DefFontName := 'Times New Roman'; +DefPreFontName := 'Courier New'; +SetImageCacheCount(5); + +FBase := ''; +FBaseEx := ''; +FBaseTarget := ''; +FCurrentFile := ''; +FTitle := ''; +FURL := ''; +FTarget := ''; + +FHistory := TStringList.Create; +FPositionHistory := TFreeList.Create; +FTitleHistory := TStringList.Create; +FDither := True; +FParseBatch := 0; {number of chars parsed before suspend} + +Visited := TStringList.Create; + +HTMLTimer := TTimer.Create(Self); +HTMLTimer.Enabled := False; +HTMLTimer.Interval := 200; +HTMLTimer.OnTimer := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLTimerTimer; +end; + +destructor ThtmlLite.Destroy; +begin +FSectionList.Free; +FNameList.Free; +FHistory.Free; +FPositionHistory.Free; +FTitleHistory.Free; +Visited.Free; +HTMLTimer.Free; +hlParser.Free; +inherited Destroy; +end; + +procedure ThtmlLite.SetupAndLogic(StartY, StartScroll, StartCount, StartCharPos: integer); +begin +FTitle := hlParser.Title; +if hlParser.Base <> '' then + FBase := hlParser.Base +else FBase := FBaseEx; +FBaseTarget := hlParser.BaseTarget; +try + DontDraw := True; + {Load the background bitmap if any and if ViewImages set} + FSectionList.GetBackgroundBitmap; + +DoLogic(StartY, StartScroll, StartCount, StartCharPos); + +finally + DontDraw := False; + end; +end; + +function ThtmlLite.AppendBatch(const St: string): string; +var + Tmp: string; +begin +if FParseBatch > 0 then + begin + Result := St; + Tmp := Copy(Result, 1, FParseBatch); + Delete(Result, 1, FParseBatch); + end +else {FParseBatch <= 0, Append all that remains} + begin + Tmp := St; + Result := ''; + end; +AppendStr(Tmp, False, Result='', True); +end; + +{----------------ThtmlLite.LoadTextFromString} +procedure ThtmlLite.LoadTextFromString(const S: string); +begin +LoadString(S, '', TextType); +end; + +{----------------ThtmlLite.LoadFromString} +procedure ThtmlLite.LoadFromString(const S, Reference: string); +begin +LoadString(S, Reference, HTMLType); +end; + +{----------------ThtmlLite.LoadString} +procedure ThtmlLite.LoadString(const Source, Reference: string; ft: ThtmlFileType); +var + I: integer; + Dest, FName, OldFile: string; + St: string; + +begin +FName := Reference; +I := Pos('#', FName); +if I > 0 then + begin + Dest := copy(FName, I+1, 255); {positioning information} + System.Delete(FName, I, 255); + end +else Dest := ''; +FRefreshDelay := 0; +try + OldFile := FCurrentFile; + FCurrentFile := ExpandFileName(FName); + FCurrentFileType := ft; + InitStr(ft); + DontDraw := True; + try + St := Source; + St := AppendBatch(St); + DontDraw := False; + while (St <> '') and not SuspendException do + St := AppendBatch(St); + finally + DontDraw := False; {make sure it's off} + while not ParseThreadHasTerminated do + begin + Application.ProcessMessages; + Sleep(0); + end; + CheckVisitedLinks; + if (Dest <> '') and PositionTo(Dest) then {change position, if applicable} + else if FCurrentFile <> OldFile then + begin + ScrollTo(0); + HScrollBar.Position := 0; + end; + {else if same file leave position alone} + PaintPanel.Invalidate; + end; +finally + SetProcessing(False); + end; +if (FRefreshDelay > 0) and Assigned(FOnMetaRefresh) then + FOnMetaRefresh(Self, FRefreshDelay, FRefreshURL); +end; + +procedure ThtmlLite.LoadFile(const FileName: string; ft: ThtmlFileType); +var + I: integer; + Dest, FName, OldFile: string; + FS: TFileStream; + St: string; + +begin +IOResult; {eat up any pending errors} +FName := FileName; +I := Pos('#', FName); +if I > 0 then + begin + Dest := copy(FName, I+1, 255); {positioning information} + System.Delete(FName, I, 255); + end +else Dest := ''; +FRefreshDelay := 0; +try + if not FileExists(FName) then + Raise(EInOutError.Create('Can''t locate file: '+FName)); + try + OldFile := FCurrentFile; + FCurrentFile := ExpandFileName(FName); + FCurrentFileType := ft; + if ft in [HTMLType, TextType] then + begin + FS := TFileStream.Create(FName, fmOpenRead or fmShareDenyWrite); + try + SetLength(St, FS.Size); + FS.ReadBuffer(St[1], FS.Size); + finally + FS.Free; + end; + end + else St := ''; + DontDraw := True; + if ft in [HTMLType, TextType] then + begin + InitStr(ft); + St := AppendBatch(St); + end + else + begin + St := ''; + InitStr(HTMLType); + AppendStr(St, False, True, True); + St := ''; + end; + DontDraw := False; + while (St <> '') and not SuspendException do + St := AppendBatch(St); + finally + DontDraw := False; + while not ParseThreadHasTerminated do + begin + Application.ProcessMessages; + Sleep(0); + end; + CheckVisitedLinks; + if (Dest <> '') and PositionTo(Dest) then {change position, if applicable} + else if FCurrentFile <> OldFile then + begin + ScrollTo(0); + HScrollBar.Position := 0; + end; + {else if same file leave position alone} + PaintPanel.Invalidate; + end; +finally + SetProcessing(False); + end; +if (FRefreshDelay > 0) and Assigned(FOnMetaRefresh) then + FOnMetaRefresh(Self, FRefreshDelay, FRefreshURL); +end; + +procedure ThtmlLite.LoadFromFile(const FileName: string); +var + OldFile, OldTitle: string; + OldPos: integer; + OldType: ThtmlFileType; +begin +if FProcessing then Exit; +if Filename <> '' then + begin + OldFile := FCurrentFile; + OldTitle := FTitle; + OldPos := Position; + OldType := FCurrentFileType; + LoadFile(FileName, HTMLType); + if (OldFile <> FCurrentFile) or (OldType <> FCurrentFileType) then + BumpHistory(OldFile, OldTitle, OldPos, OldType); + end; +end; + +{----------------ThtmlLite.LoadTextFile} +procedure ThtmlLite.LoadTextFile(const FileName: string); +var + OldFile, OldTitle: string; + OldPos: integer; + OldType: ThtmlFileType; +begin +if FProcessing then Exit; +if Filename <> '' then + begin + OldFile := FCurrentFile; + OldTitle := FTitle; + OldPos := Position; + OldType := FCurrentFileType; + LoadFile(FileName, TextType); + if (OldFile <> FCurrentFile) or (OldType <> FCurrentFileType) then + BumpHistory(OldFile, OldTitle, OldPos, OldType); + end; +end; + +{----------------ThtmlLite.LoadImageFile} +procedure ThtmlLite.LoadImageFile(const FileName: string); +var + OldFile, OldTitle: string; + OldPos: integer; + OldType: ThtmlFileType; + +begin +if FProcessing then Exit; +if Filename <> '' then + begin + OldFile := FCurrentFile; + OldTitle := FTitle; + OldPos := Position; + OldType := FCurrentFileType; + LoadFile(FileName, ImgType); + if (OldFile <> FCurrentFile) or (OldType <> FCurrentFileType) then + BumpHistory(OldFile, OldTitle, OldPos, OldType); + end; +end; + +{----------------ThtmlLite.LoadStrings} +procedure ThtmlLite.LoadStrings(const Strings: TStrings; const Reference: string); +begin +LoadString(Strings.Text, Reference, HTMLType); +end; + +{----------------ThtmlLite.LoadTextStrings} +procedure ThtmlLite.LoadTextStrings(const Strings: TStrings); +begin +LoadString(Strings.Text, '', TextType); +end; + +{----------------ThtmlLite.InitStr} +procedure ThtmlLite.InitStr(ft: ThtmlFileType); +begin +if FProcessing then Exit; +SetProcessing(True); +try + if Assigned(ParseThread) then + begin + ParseThreadHasTerminated := False; + AppendStr('', False, True, False); + While not ParseThreadHasTerminated do + begin + Application.ProcessMessages; + Sleep(0); + end; + end; + FRefreshDelay := 0; + InitLoad; + MaxVertical := 0; + CaretPos := 0; + Sel1 := -1; + OldHeight := 0; + OldWidth := 0; + OldCount := 0; + if Assigned(FOnSoundRequest) then + FOnSoundRequest(Self, '', 0, True); + ParseThread := TParseThread.Create(True); + with ParseThread do + begin + FreeOnTerminate := True; + Parser := hlParser; + ASectionList := FSectionList; + AIncludeEvent := FOnInclude; + ASoundEvent := FOnSoundRequest; + AMetaEvent := {$IFDEF HL_LAZARUS}@{$ENDIF}HandleMeta; + ANameList := FNameList; + Text := ft = TextType; + OnTerminate := {$IFDEF HL_LAZARUS}@{$ENDIF}ParserTerminate; + ParseThreadHasTerminated := False; + SuspendException := False; + end; + hlParser.ParseThread := ParseThread; + hlParser.AllowSuspend := True; + ParseThread.Resume; +except + SetProcessing(False); + Raise; + end; +end; + +{----------------ThtmlLite.AppendString} +procedure ThtmlLite.AppendString(const S: string; ViewBottom, Finish: boolean); +begin +AppendStr(S, ViewBottom, Finish, False); {Processing off on Suspend} +end; + +{----------------ThtmlLite.AppendStr} +procedure ThtmlLite.AppendStr(const S: string; ViewBottom, Finish, ProcessOn: boolean); +begin +If ((S = '') and not Finish) or ParseThreadHasTerminated or not Assigned(ParseThread) then + Exit; +while not ParseThreadHasTerminated and not ParseThread.Suspended and not SuspendException do + begin + Application.ProcessMessages; + Sleep(0); + end; +if ParseThreadHasTerminated then + Exit; +if not SuspendException then + begin + FViewBottom := ViewBottom; + ParseThread.AddString(S); + SetProcessing(True); + FProcessingOnAtSuspend := ProcessOn; + hlParser.AllowSuspend := not Finish; + end +else hlParser.AllowSuspend := False; +ParseThread.Resume; +end; + +procedure ThtmlLite.SignalSuspend; +begin +PostMessage(handle, wm_Suspend, 0, 0); +end; + +{----------------ThtmlLite.WMSuspend} +procedure ThtmlLite.WMSuspend(var Message: TMessage); +{Parser is waiting for more text} +begin +if FSectionList.Count > 0 then + begin + try + SetupAndLogic(OldHeight, OldWidth, OldCount, OldCharPos); + except + SuspendException:= True; + if not FProcessingOnAtSuspend then + SetProcessing(False); {turn off Processing for AppendString} + Raise; + end; + + if FViewBottom then + begin + VScrollBarPosition := MaxVertical; + HScrollBar.Position := 0; + end; + PaintPanel.Invalidate; + if not FProcessingOnAtSuspend then + SetProcessing(False); {turn off Processing for AppendString} + end; +end; + +procedure ThtmlLite.WMTerminate(var Message: TMessage); +begin +if (FSectionList.Count > 0) and not SuspendException then + begin + SetupAndLogic(OldHeight, OldWidth, OldCount, OldCharPos); + if FViewBottom then + begin + VScrollBarPosition := MaxVertical; + HScrollBar.Position := 0; + end; + PaintPanel.Invalidate; + end; +SetProcessing(False); +end; + +procedure ThtmlLite.ParserTerminate(Sender: TObject); +begin +ParseThreadHasTerminated := True; +ParseThread := Nil; {it's still there, though} +PostMessage(handle, wm_Terminate, 0, 0); +end; + +{----------------ThtmlLite.InitiateAppend} +procedure ThtmlLite.InitiateAppend(Ref: string); +begin +InitStr(HTMLType); +end; + +{----------------ThtmlLite.LoadFromStream} +procedure ThtmlLite.LoadFromStream(const AStream: TStream; const Reference: string); +var + Stream: TMemoryStream; + S: string; +begin +Stream := TMemoryStream.Create; +try + Stream.LoadFromStream(AStream); + SetLength(S, Stream.Size); + Move(Stream.Memory^, S[1], Stream.Size); +finally + Stream.Free; + end; +LoadString(S, Reference, HTMLType); +ScrollTo(0); +HScrollBar.Position := 0; +end; + +{----------------ThtmlLite.DoScrollBars} +procedure ThtmlLite.DoScrollBars; +var + VBar, HBar: boolean; + Wid, HWidth, WFactor: integer; + ScrollInfo :TScrollInfo; + +begin +VBar := False; +ScrollWidth := IntMin(ScrollWidth, MaxHScroll); +if FBorderStyle = htNone then + begin + WFactor := 0; + PaintPanel.Top := 0; + PaintPanel.Left := 0; + BorderPanel.Visible := False; + end +else + begin + WFactor := 1; + PaintPanel.Top := 1; + PaintPanel.Left := 1; + BorderPanel.Visible := False; + BorderPanel.Visible := True; + end; +if FScrollBars in [ssBoth, ssVertical] then + begin {assume a vertical scrollbar} + VBar := (MaxVertical >= Height-2) or + ((FScrollBars in [ssBoth, ssHorizontal]) and + (MaxVertical >= Height-2-sbWidth) and + (ScrollWidth+2*FMarginWidthX > Width-sbWidth)); + HBar := (FScrollBars in [ssBoth, ssHorizontal]) and + ((ScrollWidth+2*FMarginWidthX > Width) or + ((VBar or (htShowVScroll in FOptions)) and + (ScrollWidth+2*FMarginWidthX > Width-sbWidth))); + end +else + begin {there is no vertical scrollbar} + HBar := (FScrollBars in [ssBoth, ssHorizontal]) and + (ScrollWidth+2*FMarginWidthX > Width); + end; +if VBar or ((htShowVScroll in FOptions) and (FScrollBars in [ssBoth, ssVertical])) then + Wid := Width - sbWidth +else + Wid := Width; +PaintPanel.Width := Wid - 2*WFactor; +if HBar then + PaintPanel.Height := Height - 2*WFactor - sbWidth +else + PaintPanel.Height := Height - 2*WFactor; +HWidth := IntMax(ScrollWidth+2*FMarginWidthX, Wid-2*WFactor); +HScrollBar.Visible := HBar; +HScrollBar.LargeChange := IntMax(1, Wid - 20); +HScrollBar.SetBounds(WFactor, Height-sbWidth-WFactor, Wid -WFactor, sbWidth); +VScrollBar.SetBounds(Width-sbWidth-WFactor, WFactor, sbWidth, Height - 2*WFactor); +VScrollBar.LargeChange := PaintPanel.Height div VScale - VScrollBar.SmallChange; +if htShowVScroll in FOptions then + begin + VScrollBar.Visible := ( FScrollBars in [ssBoth, ssVertical] ); + VScrollBar.Enabled := VBar; + end +else VScrollBar.Visible := VBar; + +HScrollBar.Max := IntMax(0, HWidth); +VScrollBar.SetParams(VScrollBar.Position, PaintPanel.Height+1, 0, MaxVertical); +ScrollInfo.cbSize := SizeOf(ScrollInfo); +ScrollInfo.fMask := SIF_PAGE; +ScrollInfo.nPage := Wid; +SetScrollInfo(HScrollBar.Handle,SB_CTL,ScrollInfo,TRUE); +end; + +{----------------ThtmlLite.DoLogic} +procedure ThtmlLite.DoLogic(StartY, StartScroll, StartCount, StartCharPos: integer); +var + Curs: integer; + Wid, WFactor: integer; +begin +ScrollWidth := StartScroll; +Curs := StartCharPos; +HandleNeeded; +try + DontDraw := True; + if FBorderStyle = htNone then WFactor := 1 + else WFactor := 3; + if FScrollBars in [ssBoth, ssVertical] then + begin {assume a vertical scrollbar} + Wid := Width - sbWidth - WFactor; + OldHeight := FSectionList.DoLogic(PaintPanel.Canvas, FMarginHeightX, + Wid-2*FMarginWidthX, ScrollWidth, Curs, StartY, StartCount); + MaxVertical := OldHeight + 2*FMarginHeight; + DoScrollBars; + end + else + begin {there is no vertical scrollbar} + Wid := Width-WFactor; + OldHeight := FSectionList.DoLogic(PaintPanel.Canvas, FMarginHeightX, + Wid-2*FMarginWidthX, ScrollWidth, Curs, StartY, StartCount); + MaxVertical := OldHeight + FMarginHeight; + DoScrollBars; + end; + OldWidth := ScrollWidth; + OldCount := FSectionList.Count; + OldCharPos := Curs; + if Cursor = crIBeam then + Cursor := ThickIBeamCursor; +finally + + DontDraw := False; + end; +end; + +procedure ThtmlLite.HTMLPaint(Sender: TObject); +var + ARect: TRect; +begin +if not DontDraw then + begin + ARect := Rect(FMarginWidthX, 1, PaintPanel.Width, PaintPanel.Height); +writeln('ThtmlLite.HTMLPaint A ',ARect.Left,',',ARect.Top,',',ARect.Right,',',ARect.Bottom); + FSectionList.Draw(PaintPanel.Canvas2, ARect, MaxHScroll, + FMarginWidthX - HScrollBar.Position, FMarginHeightX); + end; +end; + +procedure ThtmlLite.WMSize(var Message: TWMSize); +begin +inherited; +if not FProcessing then + Layout +else + DoScrollBars; +if MaxVertical < PaintPanel.Height then + Position := 0 +else ScrollTo(VScrollBar.Position * integer(VScale)); {keep aligned to limits} +with HScrollBar do + Position := IntMin(Position, Max - PaintPanel.Width); +end; + +procedure ThtmlLite.Scroll(Sender: TObject; ScrollCode: TScrollCode; + var ScrollPos: Integer); +{only the 32 bit horizontal scrollbar comes here} +begin +SetFocus; +ScrollPos := IntMin(ScrollPos, HScrollBar.Max - PaintPanel.Width); +PaintPanel.Invalidate; +end; + +procedure ThtmlLite.ScrollTo(Y: integer); +begin +Y := IntMin(Y, MaxVertical - PaintPanel.Height); +Y := IntMax(Y, 0); +VScrollBar.Position := Y; +FSectionList.SetYOffset(Y); +Invalidate; +end; + +procedure ThtmlLite.Layout; +var + OldPos: integer; +begin +if FProcessing then Exit; +SetProcessing(True); +try + OldPos := Position; + DoLogic(0, 0, 0, 0); + Position := OldPos; {return to old position after width change} +finally + SetProcessing(False); + end; +end; + +function ThtmlLite.HotSpotClickHandled: boolean; +var + Handled: boolean; +begin +Handled := False; +if Assigned(FOnHotSpotClick) then + FOnHotSpotClick(Self, URL, Handled); +Result := Handled; +end; + +procedure ThtmlLite.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, FCurrentFileType); + AddVisitedLink(FCurrentFile+S); + end; + end + else + begin + if I >= 1 then + begin + Dest := System.Copy(S, I, 255); {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, 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; + +{----------------ThtmlLite.AddVisitedLink} +procedure ThtmlLite.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; + +{----------------ThtmlLite.CheckVisitedLinks} +procedure ThtmlLite.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; + +{$IFDEF HL_LAZARUS} +procedure ThtmlLite.InitializeWnd; +begin + inherited InitializeWnd; + DoScrollBars; +end; +{$ENDIF} + +procedure ThtmlLite.HTMLMouseDown(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + XR, CaretHt: integer; + YR: integer; + Cell1: TObject; + 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) then + 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-FMarginHeightX, XR, YR, CaretHt, Cell1, InText); + if Sel1 > -1 then + begin + if SelB <> SelE then + InvalidateRect(PaintPanel.Handle, Nil, True); + SelB := Sel1; + SelE := Sel1; + CaretPos := Sel1; + end; + end; + end; +end; + +procedure ThtmlLite.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 ThtmlLite.PtInObject(X, Y: integer; var Obj: TObject): boolean; {X, Y, are client coord} +var + IX, IY: integer; +begin +Result := PtInRect(ClientRect, Point(X, Y)) and + FSectionList.PtInObject(X, Y+FSectionList.YOff-FMarginHeightX, Obj, IX, IY); +end; + +procedure ThtmlLite.HTMLMouseMove(Sender: TObject; Shift: TShiftState; X, + Y: Integer); +var + UrlTarget : TUrlTarget; + CurUrl, CurTarget: string; + FormControl: TImageFormControlObj; + Obj: TObject; + IX, IY: integer; + XR, CaretHt: integer; + YR: integer; + Cell1: TObject; + InText: boolean; + NextCursor: TCursor; +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; +CurURL := ''; +NextCursor := crArrow; +if GetURL(X, Y, UrlTarget, FormControl) then + begin + NextCursor := HandCursor; + if not Assigned(FormControl) then + begin + CurUrl := UrlTarget.Url; + CurTarget := UrlTarget.Target; + UrlTarget.Free; + end; + end; +if (Assigned(FOnImageClick) or Assigned(FOnImageOver)) and + FSectionList.PtInObject(X, Y+FSectionList.YOff-FMarginHeightX, 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-FMarginHeightX, XR, YR, CaretHt, Cell1, InText) >= 0) + and InText and (NextCursor <> HandCursor) then + NextCursor := Cursor; + +PaintPanel.Cursor := NextCursor; +SetCursor(Screen.Cursors[NextCursor]); + +if ((NextCursor = HandCursor) or (SectionList.ActiveImage <> Nil)) then + HTMLTimer.Enabled := True +else HTMLTimer.Enabled := False; + +if (CurURL <> FURL) or (CurTarget <> FTarget) then + begin + FURL := CurURL; + FTarget := CurTarget; + if Assigned(FOnHotSpotCovered) then FOnHotSpotCovered(Self, CurURL); + end; +if (ssLeft in Shift) and not MouseScrolling and not FNoSelect + 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); +inherited MouseMove(Shift, X, Y); +end; + +procedure ThtmlLite.HTMLMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + UrlTarget: TUrlTarget; + FormControl: TImageFormControlObj; + Obj: TObject; + IX, IY: integer; + InImage: boolean; + Parameters: TRightClickParameters; + AWord: string; + St, En: integer; +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-FMarginHeightX, 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 GetURL(X, Y, UrlTarget, FormControl) and (UrlTarget <> Nil) then + begin + Parameters.URL := UrlTarget.URL; + Parameters.Target := UrlTarget.Target; + UrlTarget.Free; + end; + if GetWordAtCursor(X, Y, St, En, AWord) then + Parameters.ClickWord := AWord; + FOnRightClick(Self, Parameters); + finally + Parameters.Free; + end; + end; + end; + +if Button = mbLeft then + begin + MouseScrolling := False; + DoHilite(X, Y); + Hiliting := False; + if LeftButtonDown and GetURL(X, Y, UrlTarget, FormControl) then + begin + LeftButtonDown := False; + if Assigned(FormControl) then + FormControl.ImageClick + else if (FSectionList.SelE <= FSectionList.SelB) then + begin + FURL := UrlTarget.URL; + FTarget := UrlTarget.Target; + UrlTarget.Free; + HotSpotAction := True; {prevent double click action} + URLAction; + {Note: Self pointer may not be valid after URLAction call (TFrameViewer, HistoryMaxCount=0)} + end; + end; + LeftButtonDown := False; + end; +end; + +{----------------ThtmlLite.HTMLMouseWheel} +{$ifdef ver120_plus} +procedure ThtmlLite.HTMLMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +begin +VScrollBarPosition := VScrollBarPosition - WheelDelta div 2; +Handled := True; +end; +{$endif} + +{----------------ThtmlLite.GetWordAtCursor} +function ThtmlLite.GetWordAtCursor(X, Y: integer; var St, En: integer; + var AWord: string): boolean; +const + AlphNum = ['a'..'z', 'A'..'Z', '0'..'9', #192..#255]; {changed in 7.2} +var + XR, X1, CaretHt: integer; + YR, Y1: integer; + Cell1: TObject; + Obj: TObject; + Ch: char; + InText: boolean; + + function GetCh(Pos: integer): char; + var + Ch: char; + 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-FMarginHeightX, XR, YR, CaretHt, Cell1, 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 (Ch in AlphNum) then + begin + AWord := Ch; + Result := True; + Inc(en); + Ch := GetCh(en); + while Ch in AlphNum do + begin + AWord := AWord + Ch; + Inc(en); + Ch := GetCh(en); + end; + if St >= 0 then + begin + Ch := GetCh(st); + while (st >= 0) and (Ch in AlphNum) do + begin + System.Insert(Ch, AWord, 1); + Dec(st); + if St >= 0 then + Ch := GetCh(St); + end; + end; + end; + end; + end; +end; + +{----------------ThtmlLite.HTMLMouseDblClk} +procedure ThtmlLite.HTMLMouseDblClk(Message: TWMMouse); +var + st, en: integer; + AWord: string; +begin +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 ThtmlLite.DoHilite(X, Y: integer); +var + Curs, YR, YWin: integer; + CursCell: TObject; + XR, CaretHt: integer; + InText: boolean; +begin +if Hiliting and (Sel1 >= 0) then + with FSectionList do + begin + CursCell := Nil; + YWin := IntMin(IntMax(0, Y), Height); + Curs := FindCursor(PaintPanel.Canvas, X, YWin+YOff-FMarginHeightX, XR, YR, CaretHt, CursCell, 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; + +{----------------ThtmlLite.WMMouseScroll} +procedure ThtmlLite.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, MaxVertical - PaintPanel.Height)); + FSectionList.SetYOffset(Pos * integer(VScale)); + 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 ThtmlLite.PositionTo(Dest: string): boolean; +var + I: integer; +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 + ScrollTo(TSectionBase(FNameList.Objects[I]).YValue); + HScrollBar.Position := 0; + Result := True; + AddVisitedLink(FCurrentFile+'#'+Dest); + end; +end; + +function ThtmlLite.GetURL(X, Y: integer; var UrlTarg: TUrlTarget; + var FormControl: TImageFormControlObj): boolean; +begin +Result := FSectionList.GetURL(PaintPanel.Canvas, X, Y+FSectionList.YOff-FMarginHeightX, + UrlTarg, FormControl); +end; + +procedure ThtmlLite.SetViewImages(Value: boolean); +var + OldPos: integer; + OldCursor: TCursor; +begin +if (Value <> FSectionList.ShowImages) and not FProcessing then + begin + OldCursor := Screen.Cursor; + try + Screen.Cursor := crHourGlass; + SetProcessing(True); + FSectionList.ShowImages := Value; + if FSectionList.Count > 0 then + begin + FSectionList.GetBackgroundBitmap; {load any background bitmap} + OldPos := Position; + DoLogic(0, 0, 0, 0); + Position := OldPos; + Invalidate; + end; + finally + Screen.Cursor := OldCursor; + SetProcessing(False); + end; + end; +end; + +{----------------ThtmlLite.InsertImage} +function ThtmlLite.InsertImage(const Src: string; Stream: TMemoryStream): boolean; +var + OldPos: integer; + ReFormat: boolean; +begin +Result := False; +if FProcessing then Exit; +try + SetProcessing(True); + FSectionList.InsertImage(Src, Stream, Reformat); + FSectionList.GetBackgroundBitmap; {in case it's the one placed} + if Reformat then + if FSectionList.Count > 0 then + begin + FSectionList.GetBackgroundBitmap; {load any background bitmap} + OldPos := Position; + DoLogic(0, 0, 0, 0); + Position := OldPos; + end; + Invalidate; +finally + SetProcessing(False); + Result := True; + end; +end; + +function ThtmlLite.GetBase: string; +begin +Result := FBase; +end; + +procedure ThtmlLite.SetBase(Value: string); +begin +FBase := Value; +FBaseEx := Value; +end; + +function ThtmlLite.GetBaseTarget: string; +begin +Result := FBaseTarget; +end; + +function ThtmlLite.GetTitle: string; +begin +Result := FTitle; +end; + +function ThtmlLite.GetCurrentFile: string; +begin +Result := FCurrentFile; +end; + +function ThtmlLite.GetFURL: string; +begin +Result := FURL; +end; + +function ThtmlLite.GetTarget: string; +begin +Result := FTarget; +end; + +function ThtmlLite.GetViewImages: boolean; +begin +Result := FSectionList.ShowImages; +end; + +procedure ThtmlLite.SetColor(Value: TColor); +begin +if FProcessing then Exit; +FBackground := Value; +FSectionList.Background:= Value; +Color := Value; +Invalidate; +end; + +procedure ThtmlLite.SetBorderStyle(Value: THTMLBorderStyle); +begin +if Value <> FBorderStyle then + begin + FBorderStyle := Value; + DrawBorder; + end; +end; + +procedure ThtmlLite.KeyDown(var Key: Word; Shift: TShiftState); +var + Pos: integer; + OrigPos: integer; + TheChange: integer; +begin +inherited KeyDown(Key, Shift); +if MiddleScrollOn then {v7.2} + begin + MiddleScrollOn := False; + PaintPanel.Cursor := Cursor; + Exit; + end; +with VScrollBar do + if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN, VK_HOME, VK_END] then + begin + Pos := Position; + OrigPos := Pos; + case Key of + VK_PRIOR : Dec(Pos, LargeChange); + VK_NEXT : Inc(Pos, LargeChange); + VK_UP : Dec(Pos, SmallChange); + VK_DOWN : Inc(Pos, SmallChange); + VK_Home : Pos := 0; + VK_End : Pos := MaxVertical div VScale; + end; + if Pos < 0 then Pos := 0; + Pos := IntMax(0, IntMin(Pos, MaxVertical - PaintPanel.Height)); + + Position := Pos; + FSectionList.SetYOffset(Pos * integer(VScale)); + TheChange := OrigPos-Pos; + if abs(TheChange) = SmallChange then begin + ScrollWindow(PaintPanel.Handle, 0, TheChange*VScale, NIL, NIL); + PaintPanel.Update; + end else + PaintPanel.Invalidate; + end; +with HScrollBar do + if Key in [VK_LEFT, VK_RIGHT] then + begin + Pos := Position; + case Key of + VK_LEFT : Dec(Pos, SmallChange); + VK_RIGHT : Inc(Pos, SmallChange); + end; + if Pos < 0 then Pos := 0; + Pos := IntMin(Pos, Max - PaintPanel.Width); + Position := Pos; + PaintPanel.Invalidate; + end; +end; + +procedure ThtmlLite.WMGetDlgCode(var Message: TMessage); +begin +Message.Result := DLGC_WantArrows; {else don't get the arrow keys} +end; + +function ThtmlLite.GetPosition: integer; +var + Index: integer; + TopPos, Pos: integer; + S: TSectionBase; +begin +Pos := integer(VScrollBar.Position) * VScale; +S:= FSectionList.FindSectionAtPosition(Pos, TopPos, Index); +if Assigned(S) then + Result := integer(Index) shl 16 + ((Pos - TopPos) and $FFFF) +else Result := 0; +{Hiword is section #, Loword is displacement from top of section} +end; + +procedure ThtmlLite.SetPosition(Value: integer); +var + TopPos: integer; +begin +if (Value >= 0) and (Hiword(Value) < FSectionList.Count) then + begin + TopPos := FSectionList.FindPositionByIndex(HiWord(Value)); + ScrollTo(TopPos + LoWord(Value)); + end; +end; + +function ThtmlLite.GetScrollPos: integer; +begin +Result := VScrollBar.Position; +end; + +procedure ThtmlLite.SetScrollPos(Value: integer); +begin +if Value < 0 then Value := 0; +Value := IntMin(Value, VScrollBar.Max); +if Value <> GetScrollPos then + ScrollTo(integer(Value) * VScale); +end; + +function ThtmlLite.GetScrollBarRange: integer; +begin +Result := MaxVertical - PaintPanel.Height; +end; + +function ThtmlLite.GetPalette: HPALETTE; +begin +if ThePalette <> 0 then + Result := ThePalette +else Result := inherited GetPalette; +Invalidate; +end; + +function ThtmlLite.HTMLExpandFilename(const Filename: string): string; +begin +Result := HTMLServerToDos(Trim(Filename), FServerRoot); + +if Pos('\', Result) = 1 then + Result := ExpandFilename(Result) +else if (Pos(':', Result)<> 2) and (Pos('\\', Result) <> 1) then + if CompareText(FBase, 'DosPath') = 0 then {let Dos find the path} + else if FBase <> '' then + Result := ExpandFilename(HTMLToDos(FBase) + Result) + else + Result := ExpandFilename(ExtractFilePath(FCurrentFile) + Result); +end; + +{----------------ThtmlLite.BumpHistory} +procedure ThtmlLite.BumpHistory(const FileName, Title: string; + OldPos: integer; ft: ThtmlFileType); +var + I: integer; + PO: PositionObj; +begin +if (FHistoryMaxCount > 0) and (FCurrentFile <> '') and + ((FileName <> FCurrentFile) or (FCurrentFileType <> ft) + or (OldPos <> Position)) then + with FHistory do + begin + if (Count > 0) and (Filename <> '') then + begin + Strings[FHistoryIndex] := Filename; + with PositionObj(FPositionHistory[FHistoryIndex]) do + begin + Pos := OldPos; + FileType := ft; + end; + FTitleHistory[FHistoryIndex] := Title; + for I := 0 to FHistoryIndex-1 do + begin + Delete(0); + FTitleHistory.Delete(0); + PositionObj(FPositionHistory[0]).Free; + FPositionHistory.Delete(0); + end; + end; + FHistoryIndex := 0; + Insert(0, FCurrentFile); + PO := PositionObj.Create; + PO.Pos := Position; + PO.FileType := FCurrentFileType; + FPositionHistory.Insert(0, PO); + FTitleHistory.Insert(0, FTitle); + if Count > FHistoryMaxCount then + begin + Delete(FHistoryMaxCount); + FTitleHistory.Delete(FHistoryMaxCount); + PositionObj(FPositionHistory[FHistoryMaxCount]).Free; + FPositionHistory.Delete(FHistoryMaxCount); + end; + if Assigned(FOnHistoryChange) then FOnHistoryChange(Self); + end; +end; + +procedure ThtmlLite.SetHistoryIndex(Value: integer); +begin +with FHistory do + if (Value <> FHistoryIndex) and (Value >= 0) and (Value < Count) + and not FProcessing then + begin + if FCurrentFile <> '' then + begin + Strings[FHistoryIndex] := FCurrentFile; + with PositionObj(FPositionHistory[FHistoryIndex]) do + begin + Pos := Position; + FileType := FCurrentFileType; + end; + FTitleHistory[FHistoryIndex] := FTitle; + end; + with PositionObj(FPositionHistory[Value]) do + begin + if (FCurrentFile <> Strings[Value]) or (FCurrentFileType <> FileType) then + Self.LoadFile(Strings[Value], FileType); + Position := Pos; + end; + FHistoryIndex := Value; + if Assigned(FOnHistoryChange) then FOnHistoryChange(Self); + end; +end; + +procedure ThtmlLite.SetHistoryMaxCount(Value: integer); +begin +if (Value = FHistoryMaxCount) or (Value < 0) then Exit; +if Value < FHistoryMaxCount then + ClearHistory; +FHistoryMaxCount := Value; +end; + +procedure ThtmlLite.ClearHistory; +var + CountWas: integer; +begin +CountWas := FHistory.Count; +FHistory.Clear; +FTitleHistory.Clear; +FPositionHistory.Clear; +FHistoryIndex := 0; +if (CountWas > 0) and Assigned(FOnHistoryChange) then + FOnHistoryChange(Self); +end; + +function ThtmlLite.GetFontName: TFontName; +begin +Result := FFontName; +end; + +procedure ThtmlLite.SetFontName(Value: TFontName); +begin +if CompareText(Value, FSectionList.FontName) <> 0 then + begin + FFontName := Value; + FSectionList.FontName := Value; + FSectionList.UpdateFonts; + if FSectionList.Count > 0 then + Layout; + Invalidate; + end; +end; + +function ThtmlLite.GetPreFontName: TFontName; +begin +Result := FPreFontName; +end; + +procedure ThtmlLite.SetPreFontName(Value: TFontName); +begin +if CompareText(Value, FSectionList.PreFontName) <> 0 then + begin + FPreFontName := Value; + FSectionList.PreFontName := Value; + FSectionList.UpdateFonts; + if FSectionList.Count > 0 then + Layout; + Invalidate; + end; +end; + +procedure ThtmlLite.SetFontSize(Value: integer); +begin +Value := IntMax(Value, 6); {minimum value of 6 pts} +FFontSize := Value; +FSectionList.FontSize := Value; +FSectionList.UpdateFonts; +if FSectionList.Count > 0 then + Layout; +Invalidate; +end; + +{$ifdef ver100_plus} {Delphi 3,4,5, C++Builder 3, 4} +procedure ThtmlLite.SetCharset(Value: TFontCharset); +begin +FCharset := Value; +FSectionList.Charset := Value; +FSectionList.UpdateFonts; +if FSectionList.Count > 0 then + Layout; +Invalidate; +end; +{$endif} + +function ThtmlLite.GetFormControlList: TList; +begin +Result := FSectionList.FormControlList; +end; + +function ThtmlLite.GetNameList: TStringList; +begin +Result := FNameList; +end; + +function ThtmlLite.GetLinkList: TList; +begin +Result := FSectionList.LinkList; +end; + +procedure ThtmlLite.SetFontColor(Value: TColor); +begin +FFontColor := Value; +FSectionList.FontColor := Value; +FSectionList.UpdateFonts; +Invalidate; +end; + +procedure ThtmlLite.SetHotSpotColor(Value: TColor); +begin +FHotSpotColor := Value; +FSectionList.HotSpotColor := Value; +FSectionList.UpdateFonts; +Invalidate; +end; + +procedure ThtmlLite.SetVisitedColor(Value: TColor); +begin +FVisitedColor := Value; +FSectionList.LinkVisitedColor := Value; +FSectionList.UpdateFonts; +Invalidate; +end; + +procedure ThtmlLite.SetActiveColor(Value: TColor); +begin +FOverColor := Value; +FSectionList.LinkActiveColor := Value; +FSectionList.UpdateFonts; +Invalidate; +end; + +procedure ThtmlLite.SetVisitedMaxCount(Value: integer); +var + I: integer; +begin +Value := IntMax(Value, 0); +if Value <> FVisitedMaxCount then + begin + FVisitedMaxCount := Value; + if FVisitedMaxCount = 0 then + begin + Visited.Clear; + for I := 0 to SectionList.LinkList.Count-1 do + TFontObj(LinkList[I]).Visited := False; + Invalidate; + end + else + begin + FVisitedMaxCount := Value; + for I := Visited.Count-1 downto FVisitedMaxCount do + Visited.Delete(I); + end; + end; +end; + +procedure ThtmlLite.BackgroundChange(Sender: TObject); +begin +Color := (Sender as TSectionList).Background or $2000000; +end; + +procedure ThtmlLite.SetOnImageRequest(Handler: TGetImageEvent); +begin +FOnImageRequest := Handler; +FSectionList.GetImage := Handler; +end; + +procedure ThtmlLite.SetOnExpandName(Handler: TExpandNameEvent); +begin +FOnExpandName := Handler; +FSectionList.ExpandName := Handler; +end; + +procedure ThtmlLite.SetOnScript(Handler: TScriptEvent); +begin +FOnScript := Handler; +FSectionList.ScriptEvent := Handler; +end; + +procedure ThtmlLite.SetOnObjectClick(Handler: TObjectClickEvent); +begin +FOnObjectClick := Handler; +FSectionList.ObjectClick := Handler; +end; + +procedure ThtmlLite.SetOnFormSubmit(Handler: TFormSubmitEvent); +begin +FOnFormSubmit := Handler; +if Assigned(Handler) then + FSectionList.SubmitForm := {$IFDEF HL_LAZARUS}@{$ENDIF}SubmitForm +else FSectionList.SubmitForm := Nil; +end; + +procedure ThtmlLite.SubmitForm(Sender: TObject; + const Action, TheTarget, EncType, Method: string; Results: TStringList); +begin +if Assigned(FOnFormSubmit) then + begin + FAction := Action; + FMethod := Method; + FFormTarget := TheTarget; + FEncType:= EncType; + FStringList := Results; + PostMessage(Handle, wm_FormSubmit, 0, 0); + end; +end; + +procedure ThtmlLite.WMFormSubmit(var Message: TMessage); +begin +FOnFormSubmit(Self, FAction, FFormTarget, FEncType, FMethod, FStringList); +end; {user disposes of the TStringList} + +function ThtmlLite.Find(const S: String; MatchCase: boolean): boolean; +var + ChArray: array[0..256] of char; + Curs: integer; + X: integer; + Y, Pos: integer; +begin +Result := False; +if S = '' then Exit; +StrPCopy(ChArray, S); +with FSectionList do + begin + Curs := FindString(CaretPos, ChArray, MatchCase); + if Curs >= 0 then + begin + Result := True; + SelB := Curs; + SelE := Curs+Length(S); + CaretPos := SelE; + if CursorToXY(PaintPanel.Canvas, Curs, X, Y) then + begin + Pos := VScrollBarPosition * integer(VScale); + if (Y < Pos) or + (Y > Pos +ClientHeight-20) then + VScrollBarPosition := (Y - ClientHeight div 2) div VScale; + Invalidate; + end; + end; + end; +end; + +procedure ThtmlLite.FormControlEnterEvent(Sender: TObject); +var + Y, Pos: integer; +begin +if Sender is TFormControlObj then + begin + Y := TFormControlObj(Sender).YValue; + Pos := VScrollBarPosition * integer(VScale); + if (Y < Pos) or (Y > Pos +ClientHeight-20) then + begin + VScrollBarPosition := (Y - ClientHeight div 2) div VScale; + Invalidate; + end; + end; +end; + +procedure ThtmlLite.SelectAll; +var + SB: TSectionBase; +begin +with FSectionList do + if (Count > 0) and not FNoSelect then + begin + SelB := 0; + SB := TSectionBase(Items[Count-1]); + with SB do + SelE := StartCurs + Len; + Invalidate; + end; +end; + +{----------------ThtmlLite.InitLoad} +procedure ThtmlLite.InitLoad; +begin +FSectionList.Clear; +UpdateImageCache; +FSectionList.SetFonts(FFontName, FPreFontName, FFontSize, FFontColor, + FHotSpotColor, FVisitedColor, FOverColor, FBackground, + htOverLinksActive in FOptions); +FNameList.Clear; +FMarginWidthX := FMarginWidth; +FMarginHeightX := FMarginHeight; +end; + +{----------------ThtmlLite.Clear} +procedure ThtmlLite.Clear; +{Note: because of Frames do not clear history list here} +begin +if FProcessing then Exit; +HTMLTimer.Enabled := False; +FSectionList.Clear; +FSectionList.SetFonts(FFontName, FPreFontName, FFontSize, FFontColor, + FHotSpotColor, FVisitedColor, FOverColor, FBackground, + htOverLinksActive in FOptions); +FNameList.Clear; +FBase := ''; +FBaseEx := ''; +FBaseTarget := ''; +FTitle := ''; +VScrollBar.Max := 0; +VScrollBar.Visible := False; +VScrollBar.Height := PaintPanel.Height; +HScrollBar.Visible := False; +CaretPos := 0; +Sel1 := -1; +if Assigned(FOnSoundRequest) then + FOnSoundRequest(Self, '', 0, True); +Invalidate; +end; + +procedure ThtmlLite.PaintWindow(DC: HDC); +begin +PaintPanel.RePaint; +VScrollbar.RePaint; +HScrollbar.RePaint; +end; + +procedure ThtmlLite.CopyToClipboard; +begin +Clipboard.SetTextBuf(PAnsiChar(GetSelText)); +end; + +function ThtmlLite.GetSelTextBuf(Buffer: PChar; BufSize: integer): integer; +begin +if BufSize <= 0 then Result := 0 +else Result := FSectionList.GetSelTextBuf(Buffer, BufSize); +end; + +function ThtmlLite.GetSelText: string; +var + Len: integer; +begin +Len := FSectionList.GetSelLength; +if Len > 0 then + begin + SetString(Result, Nil, Len); + FSectionList.GetSelTextBuf(Pointer(Result), Len+1); + end +else Result := ''; +end; + +function ThtmlLite.GetSelLength: integer; +begin +with FSectionList do + if FCaretPos = SelB then + Result := SelE - SelB + else + Result := SelB - SelE; +end; + +procedure ThtmlLite.SetSelLength(Value: integer); +begin +with FSectionList do + begin + if Value >= 0 then + begin + SelB := FCaretPos; + SelE := FCaretPos + Value; + end + else + begin + SelE := FCaretPos; + SelB := FCaretPos + Value; + end; + Invalidate; + end; +end; + +procedure ThtmlLite.SetSelStart(Value: integer); +begin +with FSectionList do + begin + CaretPos := Value; + SelB := Value; + SelE := Value; + Invalidate; + end; +end; + +procedure ThtmlLite.SetNoSelect(Value: boolean); +begin +if Value <> FNoSelect then + begin + FNoSelect := Value; + if Value = True then + begin + FSectionList.SelB := -1; + FSectionList.SelE := -1; + RePaint; + end; + end; +end; + +procedure ThtmlLite.UpdateImageCache; +begin +BitmapList.BumpAndCheck; +end; + +procedure ThtmlLite.SetImageCacheCount(Value: integer); +begin +Value := IntMax(0, Value); +Value := IntMin(20, Value); +if Value <> FImageCacheCount then + begin + FImageCacheCount := Value; + BitmapList.SetCacheCount(FImageCacheCount); + end; +end; + +procedure ThtmlLite.DrawBorder; +begin +if (Focused and (FBorderStyle = htFocused)) or (FBorderStyle = htSingle) + or (csDesigning in ComponentState) then + BorderPanel.BorderStyle := bsSingle +else + BorderPanel.BorderStyle := bsNone; +BorderPanel.Invalidate; +end; + +procedure ThtmlLite.DoEnter; +begin +inherited DoEnter; +DrawBorder; +end; + +procedure ThtmlLite.DoExit; +begin +inherited DoExit; +DrawBorder; +end; + +procedure ThtmlLite.SetScrollBars(Value: TScrollStyle); +begin +if (Value <> FScrollBars) then + begin + FScrollBars := Value; + if not (csLoading in ComponentState) and HandleAllocated then + begin + SetProcessing(True); + try + DoLogic(0, 0, 0, 0); + finally + SetProcessing(False); + end; + Invalidate; + end; + end; +end; + +{----------------ThtmlLite.Reload} +procedure ThtmlLite.Reload; {reload the last file} +var + Pos: integer; +begin +if FCurrentFile <> '' then + begin + Pos := Position; + if FCurrentFileType = HTMLType then + LoadFromFile(FCurrentFile) + else if FCurrentFileType = TextType then + LoadTextFile(FCurrentFile) + else LoadImageFile(FCurrentFile); + Position := Pos; + end; +end; + +{----------------ThtmlLite.GetOurPalette:} +function ThtmlLite.GetOurPalette: HPalette; +begin +if ColorBits = 8 then + Result := CopyPalette(ThePalette) +else Result := 0; +end; + +{----------------ThtmlLite.SetOurPalette} +procedure ThtmlLite.SetOurPalette(Value: HPalette); +var + NewPalette: HPalette; +begin +if (Value <> 0) and (ColorBits = 8) then + begin + NewPalette := CopyPalette(Value); + if NewPalette <> 0 then + begin + if ThePalette <> 0 then + DeleteObject(ThePalette); + ThePalette := NewPalette; + if FDither then SetGlobalPalette(ThePalette); + end; + end; +end; + +{----------------ThtmlLite.SetDither} +procedure ThtmlLite.SetDither(Value: boolean); +begin +if (Value <> FDither) and (ColorBits = 8) then + begin + FDither := Value; + if Value then SetGlobalPalette(ThePalette) + else SetGLobalPalette(0); + end; +end; + +procedure ThtmlLite.SetCaretPos(Value: integer); +begin +if Value >= 0 then + FCaretPos := Value; +end; + +function ThtmlLite.FindSourcePos(DisplayPos: integer): integer; +begin +Result := FSectionList.FindSourcePos(DisplayPos); +end; + +function ThtmlLite.FindDisplayPos(SourcePos: integer; Prev: boolean): integer; +begin +Result := FSectionList.FindDocPos(SourcePos, Prev); +end; + +function ThtmlLite.DisplayPosToXy(DisplayPos: integer; var X, Y: integer): boolean; +begin +Result := FSectionList.CursorToXY(PaintPanel.Canvas, DisplayPos, X, integer(Y)); {integer() req'd for delphi 2} +end; + +{----------------ThtmlLite.SetProcessing} +procedure ThtmlLite.SetProcessing(Value: boolean); +begin +if FProcessing <> Value then + begin + FProcessing := Value; + if Assigned(FOnProcessing) and not (csLoading in ComponentState) then + FOnProcessing(Self, FProcessing); + end; +end; + +{----------------ThtmlLite.SetMarginWidth} +procedure ThtmlLite.SetMarginWidth(Value: integer); +var + OldPos: integer; + OldCursor: TCursor; +begin +if (Value <> FMarginWidth) and not FProcessing and (Value >= 0) then + begin + OldCursor := Screen.Cursor; + try + Screen.Cursor := crHourGlass; + SetProcessing(True); + FMarginWidth := IntMin(Value, 200); + FMarginWidthX := FMarginWidth; + if FSectionList.Count > 0 then + begin + OldPos := Position; + DoLogic(0, 0, 0, 0); + Position := OldPos; + Invalidate; + end; + finally + Screen.Cursor := OldCursor; + SetProcessing(False); + end; + end; +end; + +{----------------ThtmlLite.SetMarginHeight} +procedure ThtmlLite.SetMarginHeight(Value: integer); +var + OldPos: integer; + OldCursor: TCursor; +begin +if (Value <> FMarginHeight) and not FProcessing and (Value >= 0) then + begin + OldCursor := Screen.Cursor; + try + Screen.Cursor := crHourGlass; + SetProcessing(True); + FMarginHeight := IntMin(Value, 200); + FMarginHeightX := FMarginHeight; + if FSectionList.Count > 0 then + begin + OldPos := Position; + DoLogic(0, 0, 0, 0); + Position := OldPos; + Invalidate; + end; + finally + Screen.Cursor := OldCursor; + SetProcessing(False); + end; + end; +end; + +procedure ThtmlLite.SetServerRoot(Value: string); +begin +Value := Trim(Value); +if (Length(Value) >= 1) and (Value[Length(Value)] = '\') then + SetLength(Value, Length(Value)-1); +FServerRoot := Value; +end; + +procedure ThtmlLite.HandleMeta(Sender: TObject; const HttpEq, + {$IFDEF HL_LAZARUS}NewName{$ELSE}Name{$ENDIF}, Content: string); +var + DelTime, I: integer; +begin +if Assigned(FOnMeta) then FOnMeta(Self, HttpEq, + {$IFDEF HL_LAZARUS}NewName{$ELSE}Name{$ENDIF}, Content); +if Assigned(FOnMetaRefresh) then + if CompareText(Lowercase(HttpEq), 'refresh') = 0 then + begin + I := Pos(';', Content); + if I > 0 then + DelTime := StrToIntDef(copy(Content, 1, I-1), -1) + else DelTime := StrToIntDef(Content, -1); + if DelTime < 0 then Exit + else if DelTime = 0 then DelTime := 1; + I := Pos('url=', Lowercase(Content)); + if I > 0 then + FRefreshURL := Copy(Content, I+4, Length(Content)-I-3) + else FRefreshURL := ''; + FRefreshDelay := DelTime; + end; +end; + +procedure ThtmlLite.SetOptions(Value: ThtmlViewerOptions); +begin +if Value <> FOptions then + begin + FOptions := Value; + if Assigned(FSectionList) then + with FSectionList do + begin + LinksActive := htOverLinksActive in FOptions; + if htNoLinkUnderline in FOptions then + UnLine := [] + else UnLine := [fsUnderline]; + ShowDummyCaret := htShowDummyCaret in FOptions; + end; + end; +end; + +procedure ThtmlLite.Repaint; +var + I: integer; +begin +for I := 0 to FormControlList.count-1 do + with TFormControlObj(FormControlList.Items[I]) do + if Assigned(TheControl) then + TheControl.Hide; +BorderPanel.BorderStyle := bsNone; +inherited Repaint; +end; + +function ThtmlLite.GetDragDrop: TDragDropEvent; +begin +Result := FOnDragDrop; +end; + +procedure ThtmlLite.SetDragDrop(const Value: TDragDropEvent); +begin +FOnDragDrop := Value; +if Assigned(Value) then + PaintPanel.OnDragDrop := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLDragDrop +else PaintPanel.OnDragDrop := Nil; +end; + +procedure ThtmlLite.HTMLDragDrop(Sender, Source: TObject; X, Y: Integer); +begin +if Assigned(FOnDragDrop) then + FOnDragDrop(Self, Source, X, Y); +end; + +function ThtmlLite.GetDragOver: TDragOverEvent; +begin +Result := FOnDragOver; +end; + +procedure ThtmlLite.SetDragOver(const Value: TDragOverEvent); +begin +FOnDragOver := Value; +if Assigned(Value) then + PaintPanel.OnDragOver := {$IFDEF HL_LAZARUS}@{$ENDIF}HTMLDragOver +else PaintPanel.OnDragOver := Nil; +end; + +procedure ThtmlLite.HTMLDragOver(Sender, Source: TObject; X, Y: Integer; + State: TDragState; var Accept: Boolean); +begin +if Assigned(FOnDragOver) then + FOnDragOver(Self, Source, X, Y, State, Accept); +end; + +{----------------TPaintPanel.CreateIt} +constructor TPaintPanel.CreateIt(AOwner: TComponent; Viewer: TComponent); + +begin + inherited Create(AOwner); + FViewer := Viewer; +end; + +{----------------TPaintPanel.Paint} +procedure TPaintPanel.Paint; +var + MemDC: HDC; + ABitmap: HBitmap; + ARect: TRect; + OldPal: HPalette; +begin +if (FViewer as ThtmlLite).DontDraw then Exit; +ThtmlLite(FViewer).DrawBorder; +OldPal := 0; +Canvas.Font := Font; +Canvas.Brush.Color := Color; +ARect := Canvas.ClipRect; +Canvas2 := TCanvas.Create; {paint on a memory DC} +try + {$IFDEF HL_LAZARUS} + Canvas2.Handle := Canvas.Handle; + {$ELSE} + MemDC := CreateCompatibleDC(Canvas.Handle); + ABitmap := 0; + try + with ARect do + begin + ABitmap := CreateCompatibleBitmap(Canvas.Handle, Right-Left, Bottom-Top); + if (ABitmap = 0) and (Right-Left + Bottom-Top <> 0) then + raise EOutOfResources.Create('Out of Resources'); + try + SelectObject(MemDC, ABitmap); + SetWindowOrgEx(memDC, Left, Top, Nil); + Canvas2.Handle := MemDC; + {$ENDIF} + DoBackground(Canvas2, False); + if Assigned(FOnPaint) then FOnPaint(Self); + {$IFDEF HL_LAZARUS} + {$ELSE} + OldPal := SelectPalette(Canvas.Handle, ThePalette, False); + RealizePalette(Canvas.Handle); + BitBlt(Canvas.Handle, Left, Top, Right-Left, Bottom-Top, + MemDC, Left, Top, SrcCopy); + finally + if OldPal <> 0 then SelectPalette(MemDC, OldPal, False); + Canvas2.Handle := 0; + end; + end; + finally + DeleteDC(MemDC); + DeleteObject(ABitmap); + end; + {$ENDIF} +finally + Canvas2.Free; + end; +end; + +procedure TPaintPanel.DoBackground(ACanvas: TCanvas; WmErase: boolean); +var + Bitmap, Mask: TBitmap; + H, W, WW, HH, HPos, BW, BH, DCx, DCy: integer; + Pos: integer; + OldBrush: HBrush; + OldPal: HPalette; + ARect: TRect; + DC: HDC; + CopyFromDC: boolean; +begin +DC := ACanvas.handle; +if DC <> 0 then + begin + Pos := (FViewer as ThtmlLite).VScrollBarPosition * integer(VScale); + ARect := Canvas.ClipRect; + + OldPal := SelectPalette(DC, ThePalette, False); + RealizePalette(DC); + ACanvas.Brush.Color := Color or $2000000; + OldBrush := SelectObject(DC, ACanvas.Brush.Handle); + try + with FViewer as ThtmlLite do + begin + if True then {note: this code for later use for Watermarks} + HPos := HScrollBar.Position + else + begin + HPos := 0; + Pos := 0; + end; + Bitmap := FSectionList.BackgroundBitmap; + Mask := FSectionList.BackgroundMask; + if FSectionList.ShowImages and Assigned(Bitmap) then + try + DCx := 0; DCy := 0; + BW := Bitmap.Width; + BH := Bitmap.Height; + HH := (Pos div BH) * BH - Pos; + WW := (HPos div BW) * BW - HPos; + while HH < ARect.Top do + Inc(HH, BH); + while WW < ARect.Left do + Inc(WW, BW); + {to use the fast method, the bitmap must be drawn entirely within the + viewable area} + if ((HH+BH <= ARect.Bottom) and ((WW+BW <= ARect.Right) + or ((WW = ARect.Left) and (BW >= ARect.Right-ARect.Left)))) then + begin + CopyFromDC := True; {fast} + DCx := WW; + DCy := HH; + end + else CopyFromDC := False; + Dec(HH, BH); + Dec(WW, BW); + H := HH; + if Mask <> Nil then + ACanvas.FillRect(ARect); {background for transparency} + if CopyFromDC then + if Mask = Nil then + BitBlt(DC, DCx, DCy, BW, BH, Bitmap.Canvas.Handle, 0, 0, SRCCOPY) + else + begin + BitBlt(dc, DCx, DCy, BW, BH, Bitmap.Canvas.Handle, 0, 0, SrcInvert); + BitBlt(dc, DCx, DCy, BW, BH, Mask.Canvas.Handle, 0, 0, SrcAnd); + BitBlt(dc, DCx, DCy, BW, BH, Bitmap.Canvas.Handle, 0, 0, SrcPaint); + end; + repeat + W := WW; + repeat + if CopyFromDC then + BitBlt(DC, W, H, BW, BH, DC, DCx, DCy, SRCCOPY) + else if Mask = Nil then + BitBlt(DC, W, H, BW, BH, Bitmap.Canvas.Handle, 0, 0, SRCCOPY) + else + begin + BitBlt(dc, W, H, BW, BH, Bitmap.Canvas.Handle, 0, 0, SrcInvert); + BitBlt(dc, W, H, BW, BH, Mask.Canvas.Handle, 0, 0, SrcAnd); + BitBlt(dc, W, H, BW, BH, Bitmap.Canvas.Handle, 0, 0, SrcPaint); + end; + Inc(W, BW); + until W >= ARect.Right; + Inc(H, BH); + until H >= ARect.Bottom; + except + ACanvas.FillRect(ARect); + end + else + begin + ACanvas.FillRect(ARect); + end; + end; + finally + SelectObject(DC, OldBrush); + SelectPalette(DC, OldPal, False); + RealizePalette(DC); + end; + end; +end; + +procedure TPaintPanel.WMEraseBkgnd(var Message: TWMEraseBkgnd); +begin +Message.Result := 1; {it's erased} +end; + +{----------------TPaintPanel.WMLButtonDblClk} +procedure TPaintPanel.WMLButtonDblClk(var Message: TWMMouse); +begin +if Message.Keys and MK_LButton <> 0 then + ThtmlLite(FViewer).HTMLMouseDblClk(Message); +end; + +{----------------T32ScrollBar.SetParams} +procedure T32ScrollBar.SetParams(APosition, APage, AMin, AMax: Integer); +var + ScrollInfo: TScrollInfo; +begin +if (APosition <> FPosition) or (APage <> FPage) or (AMin <> FMin) + or (AMax <> FMax) then + with ScrollInfo do + begin + cbSize := SizeOf(ScrollInfo); + fMask := SIF_ALL; + if htShowVScroll in (Owner as ThtmlLite).FOptions then + fMask := fMask or SIF_DISABLENOSCROLL; + nPos := APosition; + nPage := APage; + nMin := AMin; + nMax := AMax; + SetScrollInfo(Handle, SB_CTL, ScrollInfo, True); + FPosition := APosition; + FPage := APage; + FMin := AMin; + FMax := AMax; + end; +end; + +procedure T32ScrollBar.SetPosition(Value: integer); +begin +SetParams(Value, FPage, FMin, FMax); +end; + +procedure T32ScrollBar.SetMin(Value: Integer); +begin + SetParams(FPosition, FPage, Value, FMax); +end; + +procedure T32ScrollBar.SetMax(Value: Integer); +begin + SetParams(FPosition, FPage, FMin, Value); +end; + +procedure T32ScrollBar.CNVScroll(var Message: TWMVScroll); +var + SPos: integer; + ScrollInfo: TScrollInfo; + OrigPos: integer; + TheChange: integer; +begin +Parent.SetFocus; +with ThtmlLite(Parent) do + begin + ScrollInfo.cbSize := SizeOf(ScrollInfo); + ScrollInfo.fMask := SIF_ALL; + GetScrollInfo(Self.Handle, SB_CTL, ScrollInfo); + if TScrollCode(Message.ScrollCode) = scTrack then + begin + OrigPos := ScrollInfo.nPos; + SPos := ScrollInfo.nTrackPos; + end + else + begin + SPos := ScrollInfo.nPos; + OrigPos := SPos; + case TScrollCode(Message.ScrollCode) of + scLineUp: + Dec(SPos, SmallChange); + scLineDown: + Inc(SPos, SmallChange); + scPageUp: + Dec(SPos, LargeChange); + scPageDown: + Inc(SPos, LargeChange); + scTop: + SPos := 0; + scBottom: + SPos := (MaxVertical - PaintPanel.Height) div VScale; + end; + end; + SPos := IntMax(0, IntMin(SPos, (MaxVertical - PaintPanel.Height) div VScale)); + + Self.SetPosition(SPos); + + FSectionList.SetYOffset(SPos * VScale); + TheChange := OrigPos-SPos; + + ScrollWindow(PaintPanel.Handle,0,TheChange,NIL,NIL); + PaintPanel.Update; + end; +end; + +procedure Register; +begin +RegisterComponents('Samples', [ThtmlLite]); +end; + +end. + diff --git a/components/htmllite/litecons.inc b/components/htmllite/litecons.inc new file mode 100644 index 0000000000..1d4934e6d7 --- /dev/null +++ b/components/htmllite/litecons.inc @@ -0,0 +1,91 @@ +{Version 7.25} +{Do not use this file with C++Builder 5} + +{$IFDEF HL_LAZARUS} + +{$mode ObjFPC}{$H+} +{$Define ver100_plus} +{$Define ver120_plus} +{$Define NoGIF} + +{$ELSE} + +{$A+,B-,F-,G+,I+,P+,T-,V+,X+,R-} + +{$ifdef Win32} + {$J+} {typed constants are modifiable} + {$H+} {LongStrings On} +{$endif} + +{$ifndef DebugIt} + {$W-} {Stack frames off} + {$Q-} {overflow checking off} + {$S-} {stack checking off} + {$C-} {Assertions off} + {$ifdef Win32} + {$O+} {optimization on} + {$endif} +{$else} + {$W+} {Stack frames on} + {$Q+} {overflow checking on} + {$S+} {stack checking on} + {$C+} {Assertions on} + {$ifdef Win32} + {$O-} {optimization off} + {$endif} +{$endif} + +{$Define Delphi6_Plus} + +{$ifdef ver100} {Delphi 3} +{$Define ver100_plus} +{$UnDef Delphi6_Plus} +{$endif} + +{$ifdef ver110} {C++Builder 3} +{$ObjExportAll On} +{$Define CppBuilder} +{$Define ver100_plus} +{$UnDef Delphi6_Plus} +{$endif} + +{$ifdef Ver120} {Delphi 4} +{$Define ver100_plus} +{$Define ver120_plus} +{$UnDef Delphi6_Plus} +{$endif} + +{$ifdef ver125} {C++Builder 4} +{$ObjExportAll On} +{$Define CppBuilder} +{$Define ver100_plus} +{$Define ver120_plus} +{$UnDef Delphi6_Plus} +{$endif} + +{$ifdef Ver130} {Delphi 5} +{$Define ver100_plus} +{$Define ver120_plus} +{$UnDef Delphi6_Plus} +{$endif} + +{$ifdef Ver140} {Delphi 6} +{$Define ver100_plus} +{$Define ver120_plus} + {$Warn Symbol_Platform Off} +{$endif} + +{$ifdef Ver150} {Delphi 7} +{$Define ver100_plus} +{$Define ver120_plus} + {$Warn Symbol_Platform Off} +{$endif} + + +{.$Define NoGIF} {To eliminate GIF image capability, define "NoGIF" by + removing the '.'.} + +{$DEFINE HL_INTERFACE} +{$DEFINE HL_IMPLEMENTATION} + +{$ENDIF} diff --git a/components/htmllite/litedith.pas b/components/htmllite/litedith.pas new file mode 100644 index 0000000000..38f180cf58 --- /dev/null +++ b/components/htmllite/litedith.pas @@ -0,0 +1,1745 @@ +{Version 7.5} +{***************************************************************} +{* LiteDith.PAS *} +{* *} +{* Thanks to Anders Melander, anders@melander.dk, for the *} +{* color dithering code in this module. This code was *} +{* extracted from his excellent TGifImage.pas unit. *} +{* *} +{* *} +{* Bugs introduced by Dave Baldwin *} +{***************************************************************} + + +// Copyright (c) 1997,98 Anders Melander. // +// All rights reserved. // +// // +//////////////////////////////////////////////////////////////////////////////// +// // +// This software is copyrighted as noted above. It may be freely copied, // +// modified, and redistributed, provided that the copyright notice(s) is // +// preserved on all copies. // +// // +// TGIFImage is freeware and I would like it to remain so. This means that it // +// may not be bundled with commercial libraries or sold as shareware. You are // +// welcome to use it in commercial and shareware applications providing you // +// do not charge for the functionality provided by TGIFImage. // +// If you are in doubt, please contact me and I will explain this. // +// // +// There is no warranty or other guarantee of fitness for this software, it // +// is provided solely "as is". Bug reports or fixes may be sent to the // +// author, who may or may not act on them as he desires. // +// // +// If you redistribute this code in binary form (i.e. as a library or linked // +// into an application), the accompanying documentation should state that // +// "this software is based, in part, on the work of Anders Melander" or words // +// to that effect. // +// // +// If you modify this software, you should include a notice in the revision // +// history in the history.txt file giving the date and the name of the person // +// performing the modification and a brief description of the modification. // +// // + +unit LiteDith; + +{$i LiteCons.inc} + +interface + +{$DEFINE PIXELFORMAT_TOO_SLOW} + +{$IFDEF HL_LAZARUS} + {$DEFINE VER10x} + {$DEFINE VER11_PLUS} + {$DEFINE D4_BCB3} +{$ELSE} + +//////////////////////////////////////////////////////////////////////////////// +// +// Determine Delphi and C++ Builder version +// +//////////////////////////////////////////////////////////////////////////////// + +// Delphi 2.x +{$IFDEF VER90} + Error: This module not used with Delphi 2 +{$ENDIF} + +// Delphi 3.x +{$IFDEF VER100} + {$DEFINE VER10x} +{$ENDIF} + +// C++ Builder 3.x +{$IFDEF VER110} + {$DEFINE VER10x} + {$DEFINE VER11_PLUS} + {$DEFINE D4_BCB3} +{$ENDIF} + +// Delphi 4.x +{$IFDEF VER120} + {$DEFINE VER10x} + {$DEFINE VER11_PLUS} + {$DEFINE D4_BCB3} +{$ENDIF} + +{$ifdef Ver130} {Delphi 5 and C++Builder 5} + {$DEFINE VER10x} + {$DEFINE VER11_PLUS} + {$DEFINE D4_BCB3} +{$ENDIF} + +{$ifdef ver125} {C++Builder 4} + {$DEFINE VER11_PLUS} + {$DEFINE D4_BCB3} +{$endif} + +{$ENDIF not HL_LAZARUS} + +//////////////////////////////////////////////////////////////////////////////// +// +// External dependecies +// +//////////////////////////////////////////////////////////////////////////////// +uses + {$IFDEF HL_LAZARUS} + Classes, SysUtils, VCLGlobals, LCLType, GraphType, Graphics; + {$ELSE} + sysutils, + Windows, + Graphics, + Classes; + {$ENDIF} + +//////////////////////////////////////////////////////////////////////////////// +// +// Misc constants and support types +// +//////////////////////////////////////////////////////////////////////////////// +type + // TGIFImage mostly throws exceptions of type GIFException + GIFException = class(EInvalidGraphic); + + // Color reduction methods + TColorReduction = + (rmNone, // Do not perform color reduction + rmWindows20, // Reduce to the Windows 20 color system palette + rmWindows256, // Reduce to the Windows 256 color halftone palette (Only works in 256 color display mode) + rmNetscape, // Reduce to the Netscape 216 color palette + rmMyPalette, + rmQuantizeWindows // Reduce to optimal 256 color windows palette + ); + TDitherMode = + (dmNearest, // Nearest color matching w/o error correction + dmFloydSteinberg // Floyd Steinberg Error Diffusion dithering + // dmOrdered, // Ordered dither + // dmCustom // Custom palette + ); + +//////////////////////////////////////////////////////////////////////////////// +// +// Utility routines +// +//////////////////////////////////////////////////////////////////////////////// + // WebPalette creates a 216 color uniform palette a.k.a. the Netscape Palette + function WebPalette: HPalette; + + // ReduceColors + // Map colors in a bitmap to their nearest representation in a palette using + // the methods specified by the ColorReduction and DitherMode parameters. + // The ReductionBits parameter specifies the desired number of colors (bits + // per pixel) when the reduction method is rmQuantize. + function ReduceColors(Bitmap: TBitmap; ColorReduction: TColorReduction; + DitherMode: TDitherMode): TBitmap; + +//////////////////////////////////////////////////////////////////////////////// +// +// Error messages +// +//////////////////////////////////////////////////////////////////////////////// +resourcestring + // GIF Error messages + sOutOfData = 'Premature end of data'; + sOutOfMemDIB = 'Failed to allocate memory for GIF DIB'; + sDIBCreate = 'Failed to create DIB from Bitmap'; + sNoDIB = 'Image has no DIB'; + sInvalidBitmap = 'Bitmap image is not valid'; + SInvalidPixelFormat = 'Invalid pixel format'; + SScanLine = 'Scan line index out of range'; + +function GetBitmap(Source: TPersistent): TBitmap; {LDB} +//////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////// +// +// Implementation +// +//////////////////////////////////////////////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////// +implementation + +{$IFDEF HL_LAZARUS} +function WebPalette: HPalette; +begin + Result := 0; +end; + +function GetBitmap(Source: TPersistent): TBitmap; {LDB} +begin + Result:=TBitmap.Create; + Result.Assign(Source); +end; + +function ReduceColors(Bitmap: TBitmap; ColorReduction: TColorReduction; + DitherMode: TDitherMode): TBitmap; +begin + Result:=TBitmap.Create; + Result.Assign(Bitmap); +end; + +{$ELSE} + +uses +{$ifdef DEBUG} + dialogs, +{$endif} + mmsystem, // timeGetTime() + messages, + LiteUn2; + +//////////////////////////////////////////////////////////////////////////////// +// +// Utilities +// +//////////////////////////////////////////////////////////////////////////////// + +function WebPalette: HPalette; +type + TLogWebPalette = packed record + palVersion : word; + palNumEntries : word; + PalEntries : array[0..5,0..5,0..5] of TPaletteEntry; + end; +var + r, g, b : byte; + LogWebPalette : TLogWebPalette; + LogPalette : TLogpalette absolute LogWebPalette; // Stupid typecast +begin + with LogWebPalette do + begin + palVersion:= $0300; + palNumEntries:= 216; + for r:=0 to 5 do + for g:=0 to 5 do + for b:=0 to 5 do + begin + with PalEntries[r,g,b] do + begin + peRed := 51 * r; + peGreen := 51 * g; + peBlue := 51 * b; + peFlags := 0; + end; + end; + end; + Result := CreatePalette(Logpalette); +end; + +(* +** Raise error condition +*) +procedure Error(msg: string); + function ReturnAddr: Pointer; + // From classes.pas + asm + MOV EAX,[EBP+4] // sysutils.pas says [EBP-4] ! + end; +begin + raise GIFException.Create(msg) at ReturnAddr; +end; + +// Round to arbitrary number of bits +function AlignBit(Bits, BitsPerPixel, Alignment: Cardinal): Cardinal; +begin + Dec(Alignment); + Result := ((Bits * BitsPerPixel) + Alignment) and not Alignment; + Result := Result SHR 3; +end; + +type + TPixelFormats = set of TPixelFormat; + +// -------------------------- +// InitializeBitmapInfoHeader +// -------------------------- +// Fills a TBitmapInfoHeader with the values of a bitmap when converted to a +// DIB of a specified PixelFormat. +// +// Parameters: +// Bitmap The handle of the source bitmap. +// Info The TBitmapInfoHeader buffer that will receive the values. +// PixelFormat The pixel format of the destination DIB. +// -------------------------- + +{$IFDEF D4_BCB3} + // Disable optimization to circumvent D4/BCB3 optimizer bug + {$IFOPT O+} + {$DEFINE O_PLUS} + {$O-} + {$ENDIF} +{$ENDIF} +procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader; + PixelFormat: TPixelFormat); +// From graphics.pas, "optimized" for our use +var + DIB : TDIBSection; + Bytes : Integer; +begin + FillChar(DIB, sizeof(DIB), 0); + Bytes := GetObject(Bitmap, SizeOf(DIB), @DIB); + if (Bytes = 0) then + Error(sInvalidBitmap); + + if (Bytes >= (sizeof(DIB.dsbm) + sizeof(DIB.dsbmih))) and + (DIB.dsbmih.biSize >= sizeof(DIB.dsbmih)) then + Info := DIB.dsbmih + else + begin + FillChar(Info, sizeof(Info), 0); + with Info, DIB.dsbm do + begin + biSize := SizeOf(Info); + biWidth := bmWidth; + biHeight := bmHeight; + end; + end; + case PixelFormat of + pf1bit: Info.biBitCount := 1; + pf4bit: Info.biBitCount := 4; + pf8bit: Info.biBitCount := 8; + pf24bit: Info.biBitCount := 24; + else + Error(sInvalidPixelFormat); + // Info.biBitCount := DIB.dsbm.bmBitsPixel * DIB.dsbm.bmPlanes; + end; + Info.biPlanes := 1; + Info.biSizeImage := AlignBit(Info.biWidth, Info.biBitCount, 32) * Cardinal(abs(Info.biHeight)); +end; +{$IFDEF O_PLUS} + {$O+} + {$UNDEF O_PLUS} +{$ENDIF} + +// ------------------- +// InternalGetDIBSizes +// ------------------- +// Calculates the buffer sizes nescessary for convertion of a bitmap to a DIB +// of a specified PixelFormat. +// See the GetDIBSizes API function for more info. +// +// Parameters: +// Bitmap The handle of the source bitmap. +// InfoHeaderSize +// The returned size of a buffer that will receive the DIB's +// TBitmapInfo structure. +// ImageSize The returned size of a buffer that will receive the DIB's +// pixel data. +// PixelFormat The pixel format of the destination DIB. +// +procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer; + var ImageSize: longInt; PixelFormat: TPixelFormat); +// From graphics.pas, "optimized" for our use +var + Info : TBitmapInfoHeader; +begin + InitializeBitmapInfoHeader(Bitmap, Info, PixelFormat); + // Check for palette device format + if (Info.biBitCount > 8) then + begin + // Header but no palette + InfoHeaderSize := SizeOf(TBitmapInfoHeader); + if ((Info.biCompression and BI_BITFIELDS) <> 0) then + Inc(InfoHeaderSize, 12); + end else + // Header and palette + InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * (1 shl Info.biBitCount); + ImageSize := Info.biSizeImage; +end; + +// -------------- +// InternalGetDIB +// -------------- +// Converts a bitmap to a DIB of a specified PixelFormat. +// +// Parameters: +// Bitmap The handle of the source bitmap. +// Pal The handle of the source palette. +// BitmapInfo The buffer that will receive the DIB's TBitmapInfo structure. +// A buffer of sufficient size must have been allocated prior to +// calling this function. +// Bits The buffer that will receive the DIB's pixel data. +// A buffer of sufficient size must have been allocated prior to +// calling this function. +// PixelFormat The pixel format of the destination DIB. +// +// Returns: +// True on success, False on failure. +// +// Note: The InternalGetDIBSizes function can be used to calculate the +// nescessary sizes of the BitmapInfo and Bits buffers. +// +function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE; + var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean; +// From graphics.pas, "optimized" for our use +var + OldPal : HPALETTE; + DC : HDC; +begin + InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), PixelFormat); + OldPal := 0; + DC := CreateCompatibleDC(0); + try + if (Palette <> 0) then + begin + OldPal := SelectPalette(DC, Palette, False); + RealizePalette(DC); + end; + Result := (GetDIBits(DC, Bitmap, 0, abs(TBitmapInfoHeader(BitmapInfo).biHeight), + @Bits, TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0); + finally + if (OldPal <> 0) then + SelectPalette(DC, OldPal, False); + DeleteDC(DC); + end; +end; + +// -------------- +// GetPixelFormat +// -------------- +// Returns the current pixel format of a bitmap. +// +// Replacement for delphi 3 TBitmap.PixelFormat getter. +// +// Parameters: +// Bitmap The bitmap which pixel format is returned. +// +// Returns: +// The PixelFormat of the bitmap +// +function GetPixelFormat(Bitmap: TBitmap): TPixelFormat; +begin + Result := Bitmap.PixelFormat; +end; + +// -------------- +// SetPixelFormat +// -------------- +// Changes the pixel format of a TBitmap. +// +// Replacement for delphi 3 TBitmap.PixelFormat setter. +// The returned TBitmap will always be a DIB. +// +// Note: Under Delphi 3.x this function will leak a palette handle each time it +// converts a TBitmap to pf8bit format! +// If possible, use SafeSetPixelFormat instead to avoid this. +// +// Parameters: +// Bitmap The bitmap to modify. +// PixelFormat The pixel format to convert to. +// +procedure SetPixelFormat(Bitmap: TBitmap; PixelFormat: TPixelFormat); +begin + Bitmap.PixelFormat := PixelFormat; +end; + +// ------------------ +// SafeSetPixelFormat +// ------------------ +// Changes the pixel format of a TBitmap but doesn't preserve the contents. +// +// Replacement for delphi 3 TBitmap.PixelFormat setter. +// The returned TBitmap will always be an empty DIB of the same size as the +// original bitmap. +// +// This function is used to avoid the palette handle leak that SetPixelFormat +// and TBitmap.PixelFormat suffers from. +// +// Parameters: +// Bitmap The bitmap to modify. +// PixelFormat The pixel format to convert to. + +{$IFDEF VER11_PLUS} +procedure SafeSetPixelFormat(Bitmap: TBitmap; PixelFormat: TPixelFormat); +begin + Bitmap.PixelFormat := PixelFormat; +end; +{$ELSE} + +var + pf8BitBitmap: TBitmap = nil; + +procedure SafeSetPixelFormat(Bitmap: TBitmap; PixelFormat: TPixelFormat); +var + Width , + Height : integer; +begin + if (PixelFormat = pf8bit) then + begin + // Solution to "TBitmap.PixelFormat := pf8bit" leak by Greg Chapman + if (pf8BitBitmap = nil) then + begin + // Create a "template" bitmap + // The bitmap is deleted in the finalization section of the unit. + pf8BitBitmap:= TBitmap.Create; + // Convert template to pf8bit format + // This will leak 1 palette handle, but only once + pf8BitBitmap.PixelFormat:= pf8Bit; + end; + // Store the size of the original bitmap + Width := Bitmap.Width; + Height := Bitmap.Height; + // Convert to pf8bit format by copying template + Bitmap.Assign(pf8BitBitmap); + // Restore the original size + Bitmap.Width := Width; + Bitmap.Height := Height; + end else + // This is safe since only pf8bit leaks + Bitmap.PixelFormat := PixelFormat; +end; +{$ENDIF} + + +//////////////////////////////////////////////////////////////////////////////// +// +// TDIB Class +// +// These classes gives read and write access to TBitmap's pixel data +// independantly of the Delphi version used. +// +//////////////////////////////////////////////////////////////////////////////// +type + TDIB = class(TObject) + private + FBitmap : TBitmap; + FPixelFormat : TPixelFormat; + protected + function GetScanline(Row: integer): pointer; virtual; abstract; + public + constructor Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); virtual; + property Scanline[Row: integer]: pointer read GetScanline; + property Bitmap: TBitmap read FBitmap; + end; + + TDIBReader = class(TDIB) + protected + function GetScanline(Row: integer): pointer; override; + public + constructor Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); override; + destructor Destroy; override; + end; + + TDIBWriter = class(TDIB) + private +{$ifdef PIXELFORMAT_TOO_SLOW} + FDIBInfo : PBitmapInfo; + FDIBBits : pointer; + FDIBInfoSize : integer; + FDIBBitsSize : longInt; +{$endif} + protected + procedure CreateDIB; + procedure FreeDIB; + procedure NeedDIB; + function GetScanline(Row: integer): pointer; override; + public + constructor Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); override; + destructor Destroy; override; + procedure UpdateBitmap; + end; + +//////////////////////////////////////////////////////////////////////////////// +constructor TDIB.Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); +begin + inherited Create; + FBitmap := ABitmap; + FPixelFormat := APixelFormat; +end; + +//////////////////////////////////////////////////////////////////////////////// +constructor TDIBReader.Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); +begin + inherited Create(ABitmap, APixelFormat); + SetPixelFormat(FBitmap, FPixelFormat); +end; + +destructor TDIBReader.Destroy; +begin + inherited Destroy; +end; + +function TDIBReader.GetScanline(Row: integer): pointer; +begin + Result := FBitmap.ScanLine[Row]; +end; + +//////////////////////////////////////////////////////////////////////////////// +constructor TDIBWriter.Create(ABitmap: TBitmap; APixelFormat: TPixelFormat); +{$ifndef PIXELFORMAT_TOO_SLOW} +var + SavePalette : HPalette; +{$endif} +begin + inherited Create(ABitmap, APixelFormat); +{$ifndef PIXELFORMAT_TOO_SLOW} + SavePalette := FBitmap.ReleasePalette; + try + SafeSetPixelFormat(FBitmap, FPixelFormat); + finally + FBitmap.Palette := SavePalette; + end; +{$else} + FDIBInfo := nil; + FDIBBits := nil; +{$endif} +end; + +destructor TDIBWriter.Destroy; +begin + UpdateBitmap; + FreeDIB; + inherited Destroy; +end; + +function TDIBWriter.GetScanline(Row: integer): pointer; +begin +{$ifdef PIXELFORMAT_TOO_SLOW} + NeedDIB; + + if (FDIBBits = nil) then + Error(sNoDIB); + with FDIBInfo^.bmiHeader do + begin + if (Row < 0) or (Row >= FBitmap.Height) then + raise EInvalidGraphicOperation.Create(SScanLine); + GDIFlush; + + if biHeight > 0 then // bottom-up DIB + Row := biHeight - Row - 1; + Result := PChar(Cardinal(FDIBBits) + Cardinal(Row) * AlignBit(biWidth, biBitCount, 32)); + end; +{$else} + Result := FBitmap.ScanLine[Row]; +{$endif} +end; + +procedure TDIBWriter.CreateDIB; +{$IFDEF PIXELFORMAT_TOO_SLOW} +var + SrcColors , + DstColors : WORD; + + // From Delphi 3.02 graphics.pas + // There is a bug in the ByteSwapColors from Delphi 3.0 + procedure ByteSwapColors(var Colors; Count: Integer); + var // convert RGB to BGR and vice-versa. TRGBQuad <-> TPaletteEntry + SysInfo: TSystemInfo; + begin + GetSystemInfo(SysInfo); + asm + MOV EDX, Colors + MOV ECX, Count + DEC ECX + JS @@END + LEA EAX, SysInfo + CMP [EAX].TSystemInfo.wProcessorLevel, 3 + JE @@386 + @@1: MOV EAX, [EDX+ECX*4] + BSWAP EAX + SHR EAX,8 + MOV [EDX+ECX*4],EAX + DEC ECX + JNS @@1 + JMP @@END + @@386: + PUSH EBX + @@2: XOR EBX,EBX + MOV EAX, [EDX+ECX*4] + MOV BH, AL + MOV BL, AH + SHR EAX,16 + SHL EBX,8 + MOV BL, AL + MOV [EDX+ECX*4],EBX + DEC ECX + JNS @@2 + POP EBX + @@END: + end; + end; +{$ENDIF} +begin +{$ifdef PIXELFORMAT_TOO_SLOW} + if (FBitmap.Handle = 0) then + Error(sInvalidBitmap); + + FreeDIB; + + // Get header- and pixel data size + InternalGetDIBSizes(FBitmap.Handle, FDIBInfoSize, FDIBBitsSize, FPixelFormat); + + // Allocate TBitmapInfo structure + GetMem(FDIBInfo, FDIBInfoSize); + try + // Allocate pixel buffer + FDIBBits := GlobalAllocPtr(GMEM_MOVEABLE, FDIBBitsSize); + if (FDIBBits = nil) then + raise EOutOfMemory.Create(sOutOfMemDIB); + // Get pixel data + if not(InternalGetDIB(FBitmap.Handle, FBitmap.Palette, FDIBInfo^, FDIBBits^, FPixelFormat)) then + Error(sDIBCreate); + + if (FPixelFormat <= pf8bit) then + begin + // Find number of colors defined by palette + if (FBitmap.Palette = 0) or + (GetObject(FBitmap.Palette, sizeof(SrcColors), @SrcColors) = 0) or + (SrcColors = 0) then + exit; + // Determine how many colors there are room for in DIB header + DstColors := FDIBInfo^.bmiHeader.biClrUsed; + if (DstColors = 0) then + DstColors := 1 SHL FDIBInfo^.bmiHeader.biBitCount; + // Don't copy any more colors than there are room for + if (DstColors <> 0) and (DstColors < SrcColors) then + SrcColors := DstColors; + + // Copy all colors... + GetPaletteEntries(FBitmap.Palette, 0, SrcColors, FDIBInfo^.bmiColors[0]); + // ...and convert BGR to RGB + ByteSwapColors(FDIBInfo^.bmiColors[0], SrcColors); + + // Finally zero any unused entried + if (SrcColors < DstColors) then + FillChar(pointer(LongInt(@FDIBInfo^.bmiColors)+SizeOf(TRGBQuad)*SrcColors)^, + DstColors - SrcColors, 0); + {.$ENDIF} + end; + + except + FreeDIB; + raise; + end; +{$endif} +end; + +procedure TDIBWriter.FreeDIB; +begin +{$ifdef PIXELFORMAT_TOO_SLOW} + if (FDIBInfo <> nil) then + FreeMem(FDIBInfo); + if (FDIBBits <> nil) then + GlobalFreePtr(FDIBBits); + FDIBInfo := nil; + FDIBBits := nil; +{$endif} +end; + +procedure TDIBWriter.NeedDIB; +begin +{$ifdef PIXELFORMAT_TOO_SLOW} + if (FDIBBits = nil) then + CreateDIB; +{$endif} +end; + +// Convert the DIB created by CreateDIB back to a TBitmap +procedure TDIBWriter.UpdateBitmap; +{$ifdef PIXELFORMAT_TOO_SLOW} +var + Stream : TMemoryStream; + FileSize : longInt; + BitmapFileHeader : TBitmapFileHeader; +{$endif} +begin +{$ifdef PIXELFORMAT_TOO_SLOW} + if (FDIBInfo = nil) or (FDIBBits = nil) then + exit; + Stream := TMemoryStream.Create; + try + // Make room in stream for a TBitmapInfo and pixel data + FileSize := sizeof(TBitmapFileHeader) + FDIBInfoSize + FDIBBitsSize; + Stream.SetSize(FileSize); + // Initialize file header + FillChar(BitmapFileHeader, sizeof(TBitmapFileHeader), 0); + with BitmapFileHeader do + begin + bfType := $4D42; // 'BM' = Windows BMP signature + bfSize := FileSize; // File size (not needed) + bfOffBits := sizeof(TBitmapFileHeader) + FDIBInfoSize; // Offset of pixel data + end; + // Save file header + Stream.Write(BitmapFileHeader, sizeof(TBitmapFileHeader)); + // Save TBitmapInfo structure + Stream.Write(FDIBInfo^, FDIBInfoSize); + // Save pixel data + Stream.Write(FDIBBits^, FDIBBitsSize); + + // Rewind and load DIB into bitmap + Stream.Position := 0; + FBitmap.LoadFromStream(Stream); + finally + Stream.Free; + end; +{$endif} +end; + +//////////////////////////////////////////////////////////////////////////////// +// +// Color Mapping +// +//////////////////////////////////////////////////////////////////////////////// +type + TColorLookup = class(TObject) + private + FColors : integer; + function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; virtual; abstract; + public + constructor Create(Palette: hPalette); virtual; + property Colors: integer read FColors; + end; + + PRGBQuadArray = ^TRGBQuadArray; // From Delphi 3 graphics.pas + TRGBQuadArray = array[Byte] of TRGBQuad; // From Delphi 3 graphics.pas + + BGRArray = array[0..0] of TRGBTriple; + PBGRArray = ^BGRArray; + + PalArray = array[byte] of TPaletteEntry; + PPalArray = ^PalArray; + + // TFastColorLookup implements a simple but reasonably fast generic color + // mapper. It trades precision for speed by reducing the size of the color + // space. + // Using a class instead of inline code results in a speed penalty of + // approx. 15% but reduces the complexity of the color reduction routines that + // uses it. If bitmap to GIF conversion speed is really important to you, the + // implementation can easily be inlined again. + TInverseLookup = array[0..1 SHL 15-1] of SmallInt; + PInverseLookup = ^TInverseLookup; + + TFastColorLookup = class(TColorLookup) + private + FPaletteEntries : PPalArray; + FInverseLookup : PInverseLookup; + public + constructor Create(Palette: hPalette); override; + destructor Destroy; override; + function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; override; + end; + + // TNetscapeColorLookup maps colors to the netscape 6*6*6 color cube. + TNetscapeColorLookup = class(TColorLookup) + public + constructor Create(Palette: hPalette); override; + function Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; override; + end; + +constructor TColorLookup.Create(Palette: hPalette); +begin + inherited Create; +end; + +constructor TFastColorLookup.Create(Palette: hPalette); +var + i : integer; + InverseIndex : integer; +begin + inherited Create(Palette); + + GetMem(FPaletteEntries, sizeof(TPaletteEntry) * 256); + FColors := GetPaletteEntries(Palette, 0, 256, FPaletteEntries^); + + New(FInverseLookup); + for i := low(TInverseLookup) to high(TInverseLookup) do + FInverseLookup^[i] := -1; + + // Premap palette colors + if (FColors > 0) then + for i := 0 to FColors-1 do + with FPaletteEntries^[i] do + begin + InverseIndex := (peRed SHR 3) OR ((peGreen AND $F8) SHL 2) OR ((peBlue AND $F8) SHL 7); + if (FInverseLookup^[InverseIndex] = -1) then + FInverseLookup^[InverseIndex] := i; + end; +end; + +destructor TFastColorLookup.Destroy; +begin + if (FPaletteEntries <> nil) then + FreeMem(FPaletteEntries); + if (FInverseLookup <> nil) then + Dispose(FInverseLookup); + + inherited Destroy; +end; + +// Map color to arbitrary palette +function TFastColorLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; +var + i : integer; + InverseIndex : integer; + Delta , + MinDelta , + MinColor : integer; +begin + // Reduce color space with 3 bits in each dimension + InverseIndex := (Red SHR 3) OR ((Green AND $F8) SHL 2) OR ((Blue AND $F8) SHL 7); + + if (FInverseLookup^[InverseIndex] <> -1) then + Result := char(FInverseLookup^[InverseIndex]) + else + begin + // Sequential scan for nearest color to minimize euclidian distance + MinDelta := 3 * (256 * 256); + MinColor := 0; + for i := 0 to FColors-1 do + with FPaletteEntries[i] do + begin + Delta := ABS(peRed - Red) + ABS(peGreen - Green) + ABS(peBlue - Blue); + if (Delta < MinDelta) then + begin + MinDelta := Delta; + MinColor := i; + end; + end; + Result := char(MinColor); + FInverseLookup^[InverseIndex] := MinColor; + end; + + with FPaletteEntries^[ord(Result)] do + begin + R := peRed; + G := peGreen; + B := peBlue; + end; +end; + +constructor TNetscapeColorLookup.Create(Palette: hPalette); +begin + inherited Create(Palette); + FColors := 6*6*6; // This better be true or something is wrong +end; + +// Map color to netscape 6*6*6 color cube +function TNetscapeColorLookup.Lookup(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; +begin + R := (Red+3) DIV 51; + G := (Green+3) DIV 51; + B := (Blue+3) DIV 51; + Result := char(B + 6*G + 36*R); + R := R * 51; + G := G * 51; + B := B * 51; +end; + + +//////////////////////////////////////////////////////////////////////////////// +// +// Dithering engine +// +//////////////////////////////////////////////////////////////////////////////// +type + TDitherEngine = class + protected + FDirection : integer; + FColumn : integer; + FLookup : TColorLookup; + Width : integer; + public + constructor Create(AWidth: integer; Lookup: TColorLookup); virtual; + function Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; virtual; + procedure NextLine; virtual; + + property Direction: integer read FDirection; + property Column: integer read FColumn; + end; + + // Note: TErrorTerm does only *need* to be 16 bits wide, but since + // it is *much* faster to use native machine words (32 bit), we sacrifice + // some bytes (a lot actually) to improve performance. + TErrorTerm = Integer; + TErrors = array[0..0] of TErrorTerm; + PErrors = ^TErrors; + + TFloydSteinbergEngine = class(TDitherEngine) + private + ErrorsR , + ErrorsG , + ErrorsB : PErrors; + ErrorR , + ErrorG , + ErrorB : PErrors; + CurrentErrorR , // Current error or pixel value + CurrentErrorG , + CurrentErrorB , + BelowErrorR , // Error for pixel below current + BelowErrorG , + BelowErrorB , + BelowPrevErrorR , // Error for pixel below previous pixel + BelowPrevErrorG , + BelowPrevErrorB : TErrorTerm; + + public + constructor Create(AWidth: integer; Lookup: TColorLookup); override; + destructor Destroy; override; + function Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; override; + procedure NextLine; override; + end; + +constructor TDitherEngine.Create(AWidth: integer; Lookup: TColorLookup); +begin + inherited Create; + + FLookup := Lookup; + Width := AWidth; + + FDirection := 1; + FColumn := 0; +end; + +function TDitherEngine.Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; +begin + // Map color to palette + Result := FLookup.Lookup(Red, Green, Blue, R, G, B); + inc(FColumn, FDirection); +end; + +procedure TDitherEngine.NextLine; +begin + FDirection := -FDirection; + if (FDirection = 1) then + FColumn := 0 + else + FColumn := Width-1; +end; + +constructor TFloydSteinbergEngine.Create(AWidth: integer; Lookup: TColorLookup); +begin + inherited Create(AWidth, Lookup); + + // The Error arrays has (columns + 2) entries; the extra entry at + // each end saves us from special-casing the first and last pixels. + // We can get away with a single array (holding one row's worth of errors) + // by using it to store the current row's errors at pixel columns not yet + // processed, but the next row's errors at columns already processed. We + // need only a few extra variables to hold the errors immediately around the + // current column. (If we are lucky, those variables are in registers, but + // even if not, they're probably cheaper to access than array elements are.) + GetMem(ErrorsR, sizeof(TErrorTerm)*(Width+2)); + GetMem(ErrorsG, sizeof(TErrorTerm)*(Width+2)); + GetMem(ErrorsB, sizeof(TErrorTerm)*(Width+2)); + FillChar(ErrorsR^, sizeof(TErrorTerm)*(Width+2), 0); + FillChar(ErrorsG^, sizeof(TErrorTerm)*(Width+2), 0); + FillChar(ErrorsB^, sizeof(TErrorTerm)*(Width+2), 0); + ErrorR := ErrorsR; + ErrorG := ErrorsG; + ErrorB := ErrorsB; + CurrentErrorR := 0; + CurrentErrorG := CurrentErrorR; + CurrentErrorB := CurrentErrorR; + BelowErrorR := CurrentErrorR; + BelowErrorG := CurrentErrorR; + BelowErrorB := CurrentErrorR; + BelowPrevErrorR := CurrentErrorR; + BelowPrevErrorG := CurrentErrorR; + BelowPrevErrorB := CurrentErrorR; +end; + +destructor TFloydSteinbergEngine.Destroy; +begin + FreeMem(ErrorsR); + FreeMem(ErrorsG); + FreeMem(ErrorsB); + inherited Destroy; +end; + +{$IFOPT R+} + {$DEFINE R_PLUS} + {$RANGECHECKS OFF} +{$ENDIF} +function TFloydSteinbergEngine.Dither(Red, Green, Blue: BYTE; var R, G, B: BYTE): char; +var + BelowNextError : TErrorTerm; + Delta : TErrorTerm; +begin + CurrentErrorR := Red + (CurrentErrorR + ErrorR[FDirection] + 8) DIV 16; + if (CurrentErrorR < 0) then + CurrentErrorR := 0 + else if (CurrentErrorR > 255) then + CurrentErrorR := 255; + + CurrentErrorG := Green + (CurrentErrorG + ErrorG[FDirection] + 8) DIV 16; + if (CurrentErrorG < 0) then + CurrentErrorG := 0 + else if (CurrentErrorG > 255) then + CurrentErrorG := 255; + + CurrentErrorB := Blue + (CurrentErrorB + ErrorB[FDirection] + 8) DIV 16; + if (CurrentErrorB < 0) then + CurrentErrorB := 0 + else if (CurrentErrorB > 255) then + CurrentErrorB := 255; + + // Map color to palette + Result := inherited Dither(CurrentErrorR, CurrentErrorG, CurrentErrorB, R, G, B); + + // Propagate Floyd-Steinberg error terms. + // Errors are accumulated into the error arrays, at a resolution of + // 1/16th of a pixel count. The error at a given pixel is propagated + // to its not-yet-processed neighbors using the standard F-S fractions, + // ... (here) 7/16 + // 3/16 5/16 1/16 + // We work left-to-right on even rows, right-to-left on odd rows. + + // Red component + CurrentErrorR := CurrentErrorR - R; + BelowNextError := CurrentErrorR; // Error * 1 + + Delta := CurrentErrorR * 2; + CurrentErrorR := CurrentErrorR + Delta; + ErrorR[0] := BelowPrevErrorR + CurrentErrorR; // Error * 3 + + CurrentErrorR := CurrentErrorR + Delta; + BelowPrevErrorR := BelowErrorR + CurrentErrorR; // Error * 5 + + BelowErrorR := BelowNextError; // Error * 1 + + CurrentErrorR := CurrentErrorR + Delta; // Error * 7 + + // Green component + CurrentErrorG := CurrentErrorG - G; + BelowNextError := CurrentErrorG; // Error * 1 + + Delta := CurrentErrorG * 2; + CurrentErrorG := CurrentErrorG + Delta; + ErrorG[0] := BelowPrevErrorG + CurrentErrorG; // Error * 3 + + CurrentErrorG := CurrentErrorG + Delta; + BelowPrevErrorG := BelowErrorG + CurrentErrorG; // Error * 5 + + BelowErrorG := BelowNextError; // Error * 1 + + CurrentErrorG := CurrentErrorG + Delta; // Error * 7 + + // Blue component + CurrentErrorB := CurrentErrorB - B; + BelowNextError := CurrentErrorB; // Error * 1 + + Delta := CurrentErrorB * 2; + CurrentErrorB := CurrentErrorB + Delta; + ErrorB[0] := BelowPrevErrorB + CurrentErrorB; // Error * 3 + + CurrentErrorB := CurrentErrorB + Delta; + BelowPrevErrorB := BelowErrorB + CurrentErrorB; // Error * 5 + + BelowErrorB := BelowNextError; // Error * 1 + + CurrentErrorB := CurrentErrorB + Delta; // Error * 7 + + // Move on to next column + if (FDirection = 1) then + begin + inc(longInt(ErrorR), sizeof(TErrorTerm)); + inc(longInt(ErrorG), sizeof(TErrorTerm)); + inc(longInt(ErrorB), sizeof(TErrorTerm)); + end else + begin + dec(longInt(ErrorR), sizeof(TErrorTerm)); + dec(longInt(ErrorG), sizeof(TErrorTerm)); + dec(longInt(ErrorB), sizeof(TErrorTerm)); + end; +end; +{$IFDEF R_PLUS} + {$RANGECHECKS ON} + {$UNDEF R_PLUS} +{$ENDIF} + +{$IFOPT R+} + {$DEFINE R_PLUS} + {$RANGECHECKS OFF} +{$ENDIF} +procedure TFloydSteinbergEngine.NextLine; +begin + ErrorR[0] := BelowPrevErrorR; + ErrorG[0] := BelowPrevErrorG; + ErrorB[0] := BelowPrevErrorB; + + // Note: The optimizer produces better code for this construct: + // a := 0; b := a; c := a; + // compared to this construct: + // a := 0; b := 0; c := 0; + CurrentErrorR := 0; + CurrentErrorG := CurrentErrorR; + CurrentErrorB := CurrentErrorG; + BelowErrorR := CurrentErrorG; + BelowErrorG := CurrentErrorG; + BelowErrorB := CurrentErrorG; + BelowPrevErrorR := CurrentErrorG; + BelowPrevErrorG := CurrentErrorG; + BelowPrevErrorB := CurrentErrorG; + + inherited NextLine; + + if (FDirection = 1) then + begin + ErrorR := ErrorsR; + ErrorG := ErrorsG; + ErrorB := ErrorsB; + end else + begin + ErrorR := @ErrorsR[Width+1]; + ErrorG := @ErrorsG[Width+1]; + ErrorB := @ErrorsB[Width+1]; + end; +end; +{$IFDEF R_PLUS} + {$RANGECHECKS ON} + {$UNDEF R_PLUS} +{$ENDIF} + +//////////////////////////////////////////////////////////////////////////////// +// +// Octree Color Quantization Engine +// +//////////////////////////////////////////////////////////////////////////////// +// Adapted from Earl F. Glynn's ColorQuantizationLibrary, March 1998 +//////////////////////////////////////////////////////////////////////////////// +type + TOctreeNode = class; // Forward definition so TReducibleNodes can be declared + + TReducibleNodes = array[0..7] of TOctreeNode; + + TOctreeNode = Class(TObject) + public + IsLeaf : Boolean; + PixelCount : integer; + RedSum : integer; + GreenSum : integer; + BlueSum : integer; + Next : TOctreeNode; + Child : TReducibleNodes; + + constructor Create(Level: integer; ColorBits: integer; var LeafCount: integer; + var ReducibleNodes: TReducibleNodes); + destructor Destroy; override; + end; + + TColorQuantizer = class(TObject) + private + FTree : TOctreeNode; + FLeafCount : integer; + FReducibleNodes : TReducibleNodes; + FMaxColors : integer; + FColorBits : integer; + + protected + procedure AddColor(var Node: TOctreeNode; r, g, b: byte; ColorBits: integer; + Level: integer; var LeafCount: integer; var ReducibleNodes: TReducibleNodes); + procedure DeleteTree(var Node: TOctreeNode); + procedure GetPaletteColors(const Node: TOctreeNode; + var RGBQuadArray: TRGBQuadArray; var Index: integer); + procedure ReduceTree(ColorBits: integer; var LeafCount: integer; + var ReducibleNodes: TReducibleNodes); + + public + constructor Create(MaxColors: integer; ColorBits: integer); + destructor Destroy; override; + + procedure GetColorTable(var RGBQuadArray: TRGBQuadArray); + function ProcessImage(const DIB: TDIBReader): boolean; + + property ColorCount: integer read FLeafCount; + end; + +constructor TOctreeNode.Create(Level: integer; ColorBits: integer; + var LeafCount: integer; var ReducibleNodes: TReducibleNodes); +var + i : integer; +begin + PixelCount := 0; + RedSum := 0; + GreenSum := 0; + BlueSum := 0; + for i := Low(Child) to High(Child) do + Child[i] := nil; + + IsLeaf := (Level = ColorBits); + if (IsLeaf) then + begin + Next := nil; + inc(LeafCount); + end else + begin + Next := ReducibleNodes[Level]; + ReducibleNodes[Level] := self; + end; +end; + +destructor TOctreeNode.Destroy; +var + i : integer; +begin + for i := High(Child) downto Low(Child) do + Child[i].Free; +end; + +constructor TColorQuantizer.Create(MaxColors: integer; ColorBits: integer); +var + i : integer; +begin + ASSERT(ColorBits <= 8, 'ColorBits must be 8 or less'); + + FTree := nil; + FLeafCount := 0; + + // Initialize all nodes even though only ColorBits+1 of them are needed + for i := Low(FReducibleNodes) to High(FReducibleNodes) do + FReducibleNodes[i] := nil; + + FMaxColors := MaxColors; + FColorBits := ColorBits; +end; + +destructor TColorQuantizer.Destroy; +begin + if (FTree <> nil) then + DeleteTree(FTree); +end; + +procedure TColorQuantizer.GetColorTable(var RGBQuadArray: TRGBQuadArray); +var + Index : integer; +begin + Index := 0; + GetPaletteColors(FTree, RGBQuadArray, Index); +end; + +// Handles passed to ProcessImage should refer to DIB sections, not DDBs. +// In certain cases, specifically when it's called upon to process 1, 4, or +// 8-bit per pixel images on systems with palettized display adapters, +// ProcessImage can produce incorrect results if it's passed a handle to a +// DDB. +function TColorQuantizer.ProcessImage(const DIB: TDIBReader): boolean; +var + i , + j : integer; + ScanLine : pointer; + Pixel : PRGBTriple; +begin + Result := True; + + for j := 0 to DIB.Bitmap.Height-1 do + begin + Scanline := DIB.Scanline[j]; + Pixel := ScanLine; + for i := 0 to DIB.Bitmap.Width-1 do + begin + with Pixel^ do + AddColor(FTree, rgbtRed, rgbtGreen, rgbtBlue, + FColorBits, 0, FLeafCount, FReducibleNodes); + + while FLeafCount > FMaxColors do + ReduceTree(FColorbits, FLeafCount, FReducibleNodes); + inc(Pixel); + end; + end; +end; + +procedure TColorQuantizer.AddColor(var Node: TOctreeNode; r,g,b: byte; + ColorBits: integer; Level: integer; var LeafCount: integer; + var ReducibleNodes: TReducibleNodes); +const + Mask: array[0..7] of BYTE = ($80, $40, $20, $10, $08, $04, $02, $01); +var + Index : integer; + Shift : integer; +begin + // If the node doesn't exist, create it. + if (Node = nil) then + Node := TOctreeNode.Create(Level, ColorBits, LeafCount, ReducibleNodes); + + if (Node.IsLeaf) then + begin + inc(Node.PixelCount); + inc(Node.RedSum, r); + inc(Node.GreenSum, g); + inc(Node.BlueSum, b); + end else + begin + // Recurse a level deeper if the node is not a leaf. + Shift := 7 - Level; + + Index := (((r and mask[Level]) SHR Shift) SHL 2) or + (((g and mask[Level]) SHR Shift) SHL 1) or + ((b and mask[Level]) SHR Shift); + AddColor(Node.Child[Index], r, g, b, ColorBits, Level+1, LeafCount, ReducibleNodes); + end; +end; + +procedure TColorQuantizer.DeleteTree(var Node: TOctreeNode); +var + i : integer; +begin + for i := High(TReducibleNodes) downto Low(TReducibleNodes) do + if (Node.Child[i] <> nil) then + DeleteTree(Node.Child[i]); + + Node.Free; + Node := nil; +end; + +procedure TColorQuantizer.GetPaletteColors(const Node: TOctreeNode; + var RGBQuadArray: TRGBQuadArray; var Index: integer); +var + i : integer; +begin + if (Node.IsLeaf) then + begin + with RGBQuadArray[Index] do + begin + if (Node.PixelCount <> 0) then + begin + rgbRed := BYTE(Node.RedSum DIV Node.PixelCount); + rgbGreen := BYTE(Node.GreenSum DIV Node.PixelCount); + rgbBlue := BYTE(Node.BlueSum DIV Node.PixelCount); + end else + begin + rgbRed := 0; + rgbGreen := 0; + rgbBlue := 0; + end; + rgbReserved := 0; + end; + inc(Index); + end else + begin + for i := Low(Node.Child) to High(Node.Child) do + if (Node.Child[i] <> nil) then + GetPaletteColors(Node.Child[i], RGBQuadArray, Index); + end; +end; + +procedure TColorQuantizer.ReduceTree(ColorBits: integer; var LeafCount: integer; + var ReducibleNodes: TReducibleNodes); +var + RedSum , + GreenSum , + BlueSum : integer; + Children : integer; + i : integer; + Node : TOctreeNode; +begin + // Find the deepest level containing at least one reducible node + i := Colorbits - 1; + while (i > 0) and (ReducibleNodes[i] = nil) do + dec(i); + + // Reduce the node most recently added to the list at level i. + Node := ReducibleNodes[i]; + ReducibleNodes[i] := Node.Next; + + RedSum := 0; + GreenSum := 0; + BlueSum := 0; + Children := 0; + + for i := Low(ReducibleNodes) to High(ReducibleNodes) do + if (Node.Child[i] <> nil) then + begin + inc(RedSum, Node.Child[i].RedSum); + inc(GreenSum, Node.Child[i].GreenSum); + inc(BlueSum, Node.Child[i].BlueSum); + inc(Node.PixelCount, Node.Child[i].PixelCount); + Node.Child[i].Free; + Node.Child[i] := nil; + inc(Children); + end; + + Node.IsLeaf := TRUE; + Node.RedSum := RedSum; + Node.GreenSum := GreenSum; + Node.BlueSum := BlueSum; + dec(LeafCount, Children-1); +end; + +//////////////////////////////////////////////////////////////////////////////// +// +// Octree Color Quantization Wrapper +// +//////////////////////////////////////////////////////////////////////////////// +// Adapted from Earl F. Glynn's PaletteLibrary, March 1998 +//////////////////////////////////////////////////////////////////////////////// + +// Wrapper for internal use - uses TDIBReader for bitmap access +function doCreateOptimizedPaletteForSingleBitmap(const DIB: TDIBReader; + Colors, ColorBits: integer; Windows: boolean): hPalette; +var + SystemPalette : HPalette; + ColorQuantizer : TColorQuantizer; + i : integer; + LogicalPalette : TMaxLogPalette; + RGBQuadArray : TRGBQuadArray; + Offset : integer; +begin + LogicalPalette.palVersion := $0300; + LogicalPalette.palNumEntries := Colors; + + if (Windows) then + begin + // Get the windows 20 color system palette + SystemPalette := GetStockObject(DEFAULT_PALETTE); + GetPaletteEntries(SystemPalette, 0, 10, LogicalPalette.palPalEntry[0]); + GetPaletteEntries(SystemPalette, 10, 10, LogicalPalette.palPalEntry[245]); + Colors := 236; + Offset := 10; + LogicalPalette.palNumEntries := 256; + end else + Offset := 0; + + // Normally for 24-bit images, use ColorBits of 5 or 6. For 8-bit images + // use ColorBits = 8. + ColorQuantizer := TColorQuantizer.Create(Colors, ColorBits); + try + ColorQuantizer.ProcessImage(DIB); + ColorQuantizer.GetColorTable(RGBQuadArray); + finally + ColorQuantizer.Free; + end; + + for i := 0 to Colors-1 do + with LogicalPalette.palPalEntry[i+Offset] do + begin + peRed := RGBQuadArray[i].rgbRed; + peGreen := RGBQuadArray[i].rgbGreen; + peBlue := RGBQuadArray[i].rgbBlue; + peFlags := RGBQuadArray[i].rgbReserved; + end; + Result := CreatePalette(pLogPalette(@LogicalPalette)^); +end; + +function CreateOptimizedPaletteForSingleBitmap(const Bitmap: TBitmap; + Colors, ColorBits: integer; Windows: boolean): hPalette; +var + DIB : TDIBReader; +begin + DIB := TDIBReader.Create(Bitmap, pf24bit); + try + Result := doCreateOptimizedPaletteForSingleBitmap(DIB, Colors, ColorBits, Windows); + finally + DIB.Free; + end; +end; + +//////////////////////////////////////////////////////////////////////////////// +// +// Color reduction +// +//////////////////////////////////////////////////////////////////////////////// +{$IFOPT R+} + {$DEFINE R_PLUS} + {$RANGECHECKS OFF} +{$ENDIF} +function ReduceColors(Bitmap: TBitmap; ColorReduction: TColorReduction; + DitherMode: TDitherMode): TBitmap; +var + Palette : hPalette; + ColorLookup : TColorLookup; + Ditherer : TDitherEngine; + Row : Integer; + DIBResult : TDIBWriter; + DIBSource : TDIBReader; + SrcScanLine , + Src : PRGBTriple; + DstScanLine , + Dst : PChar; + BGR : TRGBTriple; +{$ifdef DEBUG_DITHERPERFORMANCE} + TimeStart , + TimeStop : DWORD; +{$endif} + + +begin +{$ifdef DEBUG_DITHERPERFORMANCE} + timeBeginPeriod(5); + TimeStart := timeGetTime; +{$endif} + + Result := TBitmap.Create; + try + + if (ColorReduction = rmNone) then + begin + Result.Assign(Bitmap); + SetPixelFormat(Result, pf24bit); + exit; + end; + + // Set bitmap width and height + Result.Width := Bitmap.Width; + Result.Height := Bitmap.Height; + + // Set the bitmap pixel format + SafeSetPixelFormat(Result, pf8bit); + Result.Palette := 0; + + ColorLookup := nil; + Ditherer := nil; + DIBResult := nil; + DIBSource := nil; + Palette := 0; + try // Protect above resources + + // Dithering and color mapper only supports 24 bit bitmaps, + // so we have convert the source bitmap to the appropiate format. + DIBSource := TDIBReader.Create(Bitmap, pf24bit); + + try + // Create a palette based on current options + case (ColorReduction) of + rmQuantizeWindows: + Palette := CreateOptimizedPaletteForSingleBitmap(Bitmap, 256, 8, True); + rmNetscape: + Palette := WebPalette; + rmMyPalette: + Palette := CopyPalette(ThePalette); + rmWindows20: + Palette := GetStockObject(DEFAULT_PALETTE); + else + exit; + end; + + Result.Palette := Palette; + + case (ColorReduction) of + // For some strange reason my fast and dirty color lookup + // is more precise that Windows GetNearestPaletteIndex... + rmNetscape: + ColorLookup := TNetscapeColorLookup.Create(Palette); + else + ColorLookup := TFastColorLookup.Create(Palette); + end; + + // Nothing to do if palette doesn't contain any colors + if (ColorLookup.Colors = 0) then + exit; + + // Create a ditherer based on current options + case (DitherMode) of + dmNearest: + Ditherer := TDitherEngine.Create(Bitmap.Width, ColorLookup); + dmFloydSteinberg: + Ditherer := TFloydSteinbergEngine.Create(Bitmap.Width, ColorLookup); + else + exit; + end; + + // The processed bitmap is returned in pf8bit format + DIBResult := TDIBWriter.Create(Result, pf8bit); + + // Process the image + Row := 0; + while (Row < Bitmap.Height) do + begin + SrcScanline := DIBSource.ScanLine[Row]; + DstScanline := DIBResult.ScanLine[Row]; + Src := pointer(longInt(SrcScanLine) + Ditherer.Column*sizeof(TRGBTriple)); + Dst := pointer(longInt(DstScanLine) + Ditherer.Column); + + while (Ditherer.Column < Ditherer.Width) and (Ditherer.Column >= 0) do + begin + BGR := Src^; + // Dither and map a single pixel + Dst^ := Ditherer.Dither(BGR.rgbtRed, BGR.rgbtGreen, BGR.rgbtBlue, + BGR.rgbtRed, BGR.rgbtGreen, BGR.rgbtBlue); + + inc(Src, Ditherer.Direction); + inc(Dst, Ditherer.Direction); + end; + + Inc(Row); + Ditherer.NextLine; + end; + except + Result.ReleasePalette; + if (Palette <> 0) then + DeleteObject(Palette); + raise; + end; + finally + if (ColorLookup <> nil) then + ColorLookup.Free; + if (Ditherer <> nil) then + Ditherer.Free; + if (DIBResult <> nil) then + DIBResult.Free; + if (DIBSource <> nil) then + DIBSource.Free; + end; + except + Result.Free; + raise; + end; + +{$ifdef DEBUG_DITHERPERFORMANCE} + TimeStop := timeGetTime; + ShowMessage(format('Dithered %d pixels in %d mS, Rate %d pixels/mS (%d pixels/S)', + [Bitmap.Height*Bitmap.Width, TimeStop-TimeStart, + MulDiv(Bitmap.Height, Bitmap.Width, TimeStop-TimeStart+1), + MulDiv(Bitmap.Height, Bitmap.Width * 1000, TimeStop-TimeStart+1)])); + timeEndPeriod(5); +{$endif} +end; +{$IFDEF R_PLUS} + {$RANGECHECKS ON} + {$UNDEF R_PLUS} +{$ENDIF} + +function GetBitmap(Source: TPersistent): TBitmap; +var + PixelFormat : TPixelFormat; + FBitmap: TBitmap; + ColorReduction: TColorReduction; + DitherMode: TDitherMode; + +begin + Result := Nil; + if (Source is TBitmap) then {should always be} + begin + if (TBitmap(Source).Empty) then + exit; + PixelFormat := GetPixelFormat(TBitmap(Source)); + if (PixelFormat > pfDevice) then + begin + if ColorBits >= 8 then + ColorReduction := rmMyPalette + else ColorReduction := rmWindows20; + DitherMode := dmFloydSteinberg; + // Convert image to 8 bits/pixel or less + FBitmap := ReduceColors(TBitmap(Source), ColorReduction, DitherMode); + end else + begin + // Create new bitmap and copy + FBitmap := TBitmap.Create; + FBitmap.Assign(TBitmap(Source)); + end; + Result := FBitmap; + end; +end; + +{$ENDIF not HL_LAZARUS} + +end. + diff --git a/components/htmllite/litedith.rst b/components/htmllite/litedith.rst new file mode 100644 index 0000000000..bdd37ad66d --- /dev/null +++ b/components/htmllite/litedith.rst @@ -0,0 +1,28 @@ + +# hash value = 248645073 +litedith.soutofdata='Premature end of data' + + +# hash value = 232926562 +litedith.soutofmemdib='Failed to allocate memory for GIF DIB' + + +# hash value = 191780000 +litedith.sdibcreate='Failed to create DIB from Bitmap' + + +# hash value = 205693938 +litedith.snodib='Image has no DIB' + + +# hash value = 24203412 +litedith.sinvalidbitmap='Bitmap image is not valid' + + +# hash value = 76435972 +litedith.sinvalidpixelformat='Invalid pixel format' + + +# hash value = 159898837 +litedith.sscanline='Scan line index out of range' + diff --git a/components/htmllite/litegif1.pas b/components/htmllite/litegif1.pas new file mode 100644 index 0000000000..c156ac7103 --- /dev/null +++ b/components/htmllite/litegif1.pas @@ -0,0 +1,2053 @@ +{Version 9.03} + +{$i LiteCons.inc} + +unit litegif1; + +{***************************************************************} +{* htmlgif1.pas *} +{* *} +{* Thanks to Ron Collins for the Gif code in this module. *} +{* His copyright notice is below. *} +{* *} +{* This is only a portion of his code modified slightly *} +{* in a few places to accomodate my own needs. Ron's *} +{* full package may be found at www.Torry.net/gif.htm. *} +{* The zip file is rctgif.zip. *} +{* *} +{***************************************************************} + + +{ ============================================================================ + +TGif.pas copyright (C) 2000 R. Collins +rlcollins@ksaits.com + +LEGAL STUFF: + +This software is provided "as-is". This software comes without warranty +or garantee, explicit or implied. Use this software at your own risk. +The author will not be liable for any damage to equipment, data, or information +that may result while using this software. + +By using this software, you agree to the conditions stated above. + +This software may be used freely, provided the author's name and copyright +statement remain a part of the source code. + +NOTE: CompuServe, Inc. holds the patent to the compression algorithym +used in creating a GIF file. Before you save a GIF file (using LZW +compression) that may be distributed for profit, make sure you understand +the full implications and legal ramifications of using the LZW compression. + +============================================================================ } + +interface + +uses + {$ifdef UseCLX} + SysUtils, Types, Classes, QGraphics, QControls, QForms, QDialogs, + QStdCtrls; + {$else} + Windows, Messages, WinTypes, WinProcs, SysUtils, Classes, Graphics, + Controls, StdCtrls, ExtCtrls, Forms; + {$endif} + + +// LZW encode table sizes + +const + kGifCodeTableSize = 4096; + + +// the parts of a GIF file +// yes, yes, I know ... I don't have to put in "type" +// before each record definition. I just think it makes it +// easier to read, especially when the definitions may be broken +// across the printed page. if you don't like it, take them out. + +type {LDB} + TRGBQUAD = packed record + rgbBlue: Byte; + rgbGreen: Byte; + rgbRed: Byte; + rgbReserved: Byte; + end; +type + PGifDataBlock = ^TGifDataBlock; + TGifDataBlock = record // generic data clump + rSize: integer; // NOTE: array starts at "1" + rData: packed array[1..255] of byte; + end; + +type + PGifSignature = ^TgifSignature; + TGifSignature = record // GIF87A or GIF89A + rSignature: packed array[1..6] of char; + end; + +type + PGifExtensionGraphic = ^TgifExtensionGraphic; + TGifExtensionGraphic = record // graphic control extension + rBlockSize: integer; // must always be 4 + rDisposal: integer; // disposal method when drawing + rUserInputValid: boolean; // wait for user input? + rTransparentValid: boolean; // transparent color given? + rDelayTime: integer; // delay between display images + rTransparentIndex: integer; // into color table + end; + +type + PGifExtensionComment = ^TgifExtensionComment; + TGifExtensionComment = record // comment extension + rDataBlockList: TList; // data blocks + end; + +type + PGifExtensionText = ^TGifExtensionText; + TGifExtensionText = record // plain text extension + rBlockSize: integer; // must always be 12 + rGridLeft: integer; // text grid position + rGridTop: integer; + rGridWidth: integer; // text grid size + rGridHeight: integer; + rCellWidth: integer; // size of a character cell + rCellHeight: integer; + rForegroundIndex: integer; // text foreground color + rBackgroundIndex: integer; // text background color + rDataBlockList: TList; // data blocks + end; + +type + PGifExtensionApplication = ^TgifExtensionApplication; + TGifExtensionApplication = record // application extension + rBlockSize: integer; // must always be 11 + rIdentifier: packed array[1..8] of char; + rAuthentication: packed array[1..3] of char; + rDataBlockList: TList; // data blocks + end; + +type + PGifExtension = ^TGifExtension; + TGifExtension = record // for any extension type + case rLabel: byte of // cannot use CONST names + $f9: (rGraphic: TGifExtensionGraphic); + $fe: (rComment: TGifExtensionComment); + $01: (rText: TGifExtensionText); + $ff: (rApp: TGifExtensionApplication); + $00: (rDummy: longint); + end; + +type + PGifScreenDescriptor = ^TGifScreenDescriptor; + TGifScreenDescriptor = record + rWidth: integer; // size of logical screen + rHeight: integer; // size of logical screen + rGlobalColorValid: boolean; // global color table found in file? + rColorResolution: integer; // bits per color + rSorted: boolean; // global colors are sorted? + rGlobalColorSize: integer; // size of global color table + rBackgroundIndex: integer; // background color index + rAspectRatio: integer; // pixel aspect ratio + rGlobalColorTable: integer; // default color table for all images + end; + +type + PGifColorTable = ^TGifColorTable; // pointer to a color table + TGifColorTable = record + rSize: integer; // number of valid entries + rColors: array[0..255] of TColor; // the colors + end; + +type + PGifImageDescriptor = ^TGifImageDescriptor; + TGifImageDescriptor = record + rIndex: integer; // which image is this? + rLeft: integer; // position of image + rTop: integer; // position of image + rWidth: integer; // size of image + rHeight: integer; // size of image + rLocalColorValid: boolean; // color table used? + rInterlaced: boolean; // interlaced lines? + rSorted: boolean; // color table sorted? + rLocalColorSize: integer; // number entries in local color table + rLocalColorTable: integer; // index into master list + rLZWSize: integer; // LZW minimum code size + rExtensionList: TList; // extensions read before this image + rPixelList: PChar; // decoded pixel indices + rPixelCount: longint; // number of pixels + rBitmap: TBitmap; // the actual image + end; + + +type + PGifZip = ^TGifZip; + TGifZip = record + rID: PGifImageDescriptor; // image parameters to decode + rCT: PGifColorTable; // color table for this image + rPrefix: array[0..kGifCodeTableSize-1] of integer; // string prefixes + rSuffix: array[0..kGifCodeTableSize-1] of integer; // string suffixes + rCodeStack: array[0..kGifCodeTableSize-1] of byte; // decode/encoded pixels + rSP: integer; // pointer into CodeStack + rClearCode: integer; // reset decode params + rEndCode: integer; // last code in input stream + rHighCode: integer; // highest LZW code possible + rCurSize: integer; // current code size + rBitString: integer; // steady stream of bits to be decoded + rBits: integer; // number of valid bits in BitString + rCurSlot: integer; // next stack index to store a code + rTopSlot: integer; // highest slot used so far + rMaxVal: boolean; // max code value found? + rCurX: integer; // position of next pixel + rCurY: integer; // position of next pixel + rCurPass: integer; // pixel line pass 1..4 + rFirstSlot: integer; // for encoding an image + rNextSlot: integer; // for encoding + rCount: integer; // number of bytes read/written + rLast: integer; // last byte read in + rUnget: boolean; // read a new byte, or use zLast? + end; + +{ ---------------------------------------------------------------------------- } + +// define a GIF + +type + TGif = class(TObject) + private + fIOStream: TMemoryStream; // read or write the image + fDataStream: TMemoryStream; // temp storage for LZW + fExtension: TList; // latest extensions read/written + + fSignature: PGifSignature; // version of GIF + fScreenDescriptor: PGifScreenDescriptor; // logical screen descriptor + fImageDescriptorList: TList; // list of all images + fColorTableList: TList; // list of all color tables + fPaletteList: TList; // list of palettes from color tables + fZipData: PGifZip; // for encode/decode image + FLoopCount: integer; // number of animated iterations + + +// functions that override TGraphic items + + protected + function GetHeight: integer; + function GetWidth: integer; + function GetTransparent: boolean; + +// procedures to read a bitmap + + private + procedure ReadSignature; + procedure ReadScreenDescriptor; + procedure ReadColorTable(Size: integer; var Table: integer); + procedure ReadImageDescriptor; + procedure ReadDataBlockList(List: TList); + procedure ReadExtension(var Done: boolean); + procedure ReadSourceInteger(size: integer; var value: integer); + +// LZW encode and decode + + procedure LZWDecode(pID: PGifImageDescriptor); + procedure LZWInit(pID: PGifImageDescriptor); + procedure LZWFinit; + procedure LZWReset; + function LZWGetCode: integer; + procedure LZWSaveCode(Code: integer); + procedure LZWDecodeCode(var Code: integer); + procedure LZWSaveSlot(Prefix, Suffix: integer); + procedure LZWIncrPosition; + procedure LZWCheckSlot; + procedure LZWWriteBitmap; + function LZWReadBitmap: integer; + +// procedures used to implement the PROPERTIES + + function GetSignature: string; + function GetScreenDescriptor: PGifScreenDescriptor; + function GetImageCount: integer; + function GetImageDescriptor(image: integer): PGifImageDescriptor; + function GetBitmap(image: integer): TBitmap; + function GetColorTableCount: integer; + function GetColorTable(table: integer): PGifColorTable; + function GetImageDelay(Image: integer): integer; {LDB} + function GetImageDisposal(Image: integer): integer; {LDB} + function GetColorIndex(image, x, y: integer): integer; + function GetTransparentIndex(image: integer): integer; + function GetTransparentColor: TColor; + function GetImageLeft(image: integer): integer; + function GetImageTop(image: integer): integer; + function GetImageWidth(image: integer): integer; + function GetImageHeight(image: integer): integer; + function GetImageDepth(image: integer): integer; + +// generally usefull routines + + procedure FreeDataBlockList(var list: TList); + procedure FreeExtensionList(var list: TList); + procedure MakeBitmaps; + function FindGraphicExtension(image: integer): PGifExtensionGraphic; + function FindColorIndex(c: TColor; ct: PGifColorTable): integer; + procedure ExtractLoopCount(List: TList); + + public + constructor Create; + destructor Destroy; override; + procedure FreeImage; + + procedure LoadFromStream(Source: TStream); + function GetStripBitmap(var Mask: TBitmap): TBitmap; {LDB} + + property Signature: string read GetSignature; + property ScreenDescriptor: PGifScreenDescriptor read GetScreenDescriptor; + property ImageCount: integer read GetImageCount; + property ImageDescriptor[Image: integer]: PGifImageDescriptor read GetImageDescriptor; + property Bitmap[Image: integer]: TBitmap read GetBitmap; + property ColorTableCount: integer read GetColorTableCount; + property ColorTable[Table: integer]: PGifColorTable read GetColorTable; + property Height: integer read GetHeight; + property Width: integer read GetWidth ; + + property ImageDelay[Image: integer]: integer read GetImageDelay; + property ImageDisposal[Image: integer]: integer read GetImageDisposal; + + property Transparent: boolean read GetTransparent; + property TransparentIndex[Image: integer]: integer read GetTransparentIndex; + property TransparentColor: TColor read GetTransparentColor; + property ImageLeft[Image: integer]: integer read GetImageLeft; + property ImageTop[Image: integer]: integer read GetImageTop; + property ImageWidth[Image: integer]: integer read GetImageWidth; + property ImageHeight[Image: integer]: integer read GetImageHeight; + property ImageDepth[Image: integer]: integer read GetImageDepth; + property LoopCount: integer read FLoopCount; + + end; + +implementation + +const + TransColor = $170725; + + // GIF record separators + +const + kGifImageSeparator: byte = $2c; + kGifExtensionSeparator: byte = $21; + kGifTerminator: byte = $3b; + kGifLabelGraphic: byte = $f9; + kGifLabelComment: byte = $fe; + kGifLabelText: byte = $01; + kGifLabelApplication: byte = $ff; + +// define a set of error messages + +const + kGifErrorMessages: array[0..25] of string = ( + 'no error', // 0 + 'Invalid GIF Signature Code', // 1 + 'No Local or Global Color Table for Image', // 2 + 'Unknown Graphics Extension Type', // 3 + 'Unknown Graphics Operation Code', // 4 + 'Invalid Extension Block Size', // 5 + '[special message]', // 6 + 'Invalid Extension Block Terminator', // 7 + 'Invalid Integer Size', // 8 + 'No GIF Terminator Found', // 9 + 'Extension Block Out-Of-Order With Image Data', // 10 + 'Invalid Image Descriptor Index', // 11 + 'Invalid LZW Code Size', // 12 + 'Invalid LZW Data Format', // 13 + 'LZW Code Overflow', // 14 + 'Value Out Of Range', // 15 + 'NIL Pointer assigned', // 16 + 'Invalid Color Table Size', // 17 + 'No Image Description', // 18 + 'Invalid Bitmap Image', // 19 + 'Invalid Color Table Index', // 20 + 'Invalid Interlace Pass', // 21 + 'Invalid Bitmap', // 22 + 'Too Many Colors In Bitmap', // 23 + 'Unexpected end of file', // 24 {LDB} + 'next message' // + ); + +var + GIF_ErrorCode: integer; // last error + GIF_ErrorString: string; // last error + +procedure GIF_Error(n: integer); forward; +procedure GIF_ErrorMessage(m: string); forward; + + +constructor TGif.Create; +begin +inherited Create; + +// nothing defined yet + +fIOStream := nil; +fDataStream := nil; +fExtension := nil; +fSignature := nil; +fScreenDescriptor := nil; +fImageDescriptorList := nil; +fColorTableList := nil; +fPaletteList := nil; +fZipData := nil; +FLoopCount := -1; // -1 is no loop count entered + +// some things, though, will always be needed + +new(fSignature); +if (fSignature = nil) then OutOfMemoryError; +fSignature^.rSignature := '------'; + +new(fScreenDescriptor); +if (fScreenDescriptor = nil) then OutOfMemoryError; +fillchar(fScreenDescriptor^, sizeof(TGifScreenDescriptor), 0); + +fImageDescriptorList := TList.Create; +fColorTableList := TList.Create; +fPaletteList := TList.Create; + +end; + + +destructor TGif.Destroy; +begin + +// clean up most of the data + +FreeImage; + +// and then the left-overs + +dispose(fSignature); +dispose(fScreenDescriptor); + +fImageDescriptorList.Free; +fColorTableList.Free; +fPaletteList.Free; + +// and the ancestor + +inherited; +end; + +{ ---------------------------------------------------------------------------- } +{ release all memory used to store image data } + +procedure TGif.FreeImage; +var + i: integer; + id: PGifImageDescriptor; + ct: PGifColorTable; +begin + +// temp input/output stream + +if (fIOStream <> nil) then fIOStream.Free; +fIOStream := nil; + +// temp encoded data + +if (fDataStream <> nil) then fDataStream.Free; +fDataStream:= nil; + +// temp list of image extensions + +if (fExtension <> nil) then FreeExtensionList(fExtension); +fExtension := nil; + +// signature record stays, but is cleared + +if (fSignature = nil) then new(fSignature); +fSignature^.rSignature := '------'; + +// ditto the screen descriptor + +if (fScreenDescriptor = nil) then new(fScreenDescriptor); +fillchar(fScreenDescriptor^, sizeof(TGifScreenDescriptor), 0); + +// delete all items from image list, but leave the list + +if (fImageDescriptorList = nil) then fImageDescriptorList := TList.Create; +for i := 0 to (fImageDescriptorList.Count - 1) do + begin + id := fImageDescriptorList.Items[i]; + if (id <> nil) then + begin + if (id^.rExtensionList <> nil) then FreeExtensionList(id^.rExtensionList); + if (id^.rPixelList <> nil) then freemem(id^.rPixelList); + if (id^.rBitmap <> nil) then id^.rBitmap.Free; + + dispose(id); + end; + end; +fImageDescriptorList.Clear; + +// release color tables, but keep the list + +if (fColorTableList = nil) then fColorTableList := TList.Create; +for i := 0 to (fColorTableList.Count - 1) do + begin + ct := fColorTableList.Items[i]; + if (ct <> nil) then dispose(ct); + end; +fColorTableList.Clear; + +// once again, keep the palette list object, but not the data + +if (fPaletteList = nil) then fPaletteList := TList.Create; +fPaletteList.Clear; + +// don't need the zip/unzip data block + +if (fZipData <> nil) then dispose(fZipData); +fZipData := nil; +end; + + +{ ---------------------------------------------------------------------------- } +{ READ and WRITE A GIF ------------------------------------------------------- } + +{ ---------------------------------------------------------------------------- } +{ read a GIF definition from a stream } + +procedure TGif.LoadFromStream(Source: TStream); +var + done: boolean; + b: byte; +begin + +// release old image that may be here ... + +FreeImage; + +// no error yet + +GIF_ErrorCode := 0; +GIF_ErrorString := ''; + +// make a local copy of the source data +// memory streams are faster and easier to manipulate than file streams + +fIOStream := TMemoryStream.Create; +Source.Position := 0; +fIOStream.LoadFromStream(Source); + +// local temp vars + +fDataStream := TMemoryStream.Create; // data to be un-zipped +fExtension := nil; // extensions to an image + + +// read the signature GIF87A or GIF89A + +ReadSignature; + +// read the logical screen descriptor + +ReadScreenDescriptor; + +// read extensions and image data until end of file + +done := false; +while (not done) do + begin + if (fIOStream.Position >= fIOStream.Size) then GIF_Error(9); + + fIOStream.Read(b, 1); // image separator + + if (b = 0) then // just skip this? + begin + b := 0; + Done := True; {LDB} + end + else if (b = kGifTerminator) then // got it all + begin + done := true; + end + else if (b = kGifImageSeparator) then // next bitmap + begin + ReadImageDescriptor; + end + else if (b = kGifExtensionSeparator) then // special operations + begin + ReadExtension(Done); + end + else // unknown + begin + GIF_Error(4); + end; + end; + +// must have an image + +if (fImageDescriptorList.Count = 0) then GIF_Error(18); + +// no longer need the source data in memory + +fIOStream.Free; +fDataStream.Free; +FreeExtensionList(fExtension); + +fIOStream := nil; +fDataStream := nil; +fExtension := nil; +end; + + +function TGif.GetHeight: integer; +begin +GetHeight := fScreenDescriptor^.rHeight; +end; + +function TGif.GetWidth: integer; +begin +GetWidth := fScreenDescriptor^.rWidth; +end; + +{ ---------------------------------------------------------------------------- } +{ TRANSPARENT is assument to be the same for all images; i.e., if the first } +{ image is transparent, they they are all transparent } +{ if SetTransparent(TRUE) then set default color index for transparent color } +{ this can be changed with TransparentColor after this call } + +{LDB changed so that if any images are transparent, Transparent returns True} +function TGif.GetTransparent: boolean; +var + b: boolean; + gx: PGifExtensionGraphic; + i: integer; +begin +b := false; +for I := 0 to (fImageDescriptorList.Count - 1) do + begin + gx := FindGraphicExtension(I); + if (gx <> nil) then + b := gx^.rTransparentValid or b; + end; + +GetTransparent := b; +end; + +{ ---------------------------------------------------------------------------- } +{ PROCEDURES TO READ A GIF FILE ---------------------------------------------- } + +{ ---------------------------------------------------------------------------- } +{ read the GIF signature from the source stream } +{ this assumes the memory stream position is correct } +{ the signature is always 6 bytes, and must be either GIF87A or GIF89A } + +procedure TGif.ReadSignature; +var + s: string; +begin +with fSignature^ do + begin + fIOStream.Read(rSignature, 6); + s := rSignature; + s := UpperCase(s); + if ((s <> 'GIF87A') and (s <> 'GIF89A')) then GIF_Error(1); + end; +end; + + +{ ---------------------------------------------------------------------------- } +{ read the GIF logical screen descriptor from the source stream } +{ this assumes the memory stream position is correct } +{ this always follows the GIF signature } + +procedure TGif.ReadScreenDescriptor; +var + i,n: integer; +begin +with fScreenDescriptor^ do + begin + ReadSourceInteger(2, rWidth); // logical screen width + ReadSourceInteger(2, rHeight); // logical screen height + + ReadSourceInteger(1, n); // packed bit fields + rGlobalColorValid := ((n and $80) <> 0); + rColorResolution := ((n shr 4) and $07) + 1; + rSorted := ((n and $08) <> 0); + + i := (n and $07); + if (i = 0) then rGlobalColorSize := 2 + else if (i = 1) then rGlobalColorSize := 4 + else if (i = 2) then rGlobalColorSize := 8 + else if (i = 3) then rGlobalColorSize := 16 + else if (i = 4) then rGlobalColorSize := 32 + else if (i = 5) then rGlobalColorSize := 64 + else if (i = 6) then rGlobalColorSize := 128 + else if (i = 7) then rGlobalColorSize := 256 + else rGlobalColorSize := 256; + + + ReadSourceInteger(1, rBackgroundIndex); // background color + ReadSourceInteger(1, rAspectRatio); // pixel aspect ratio + +// read the global color table from the source stream +// this assumes the memory stream position is correct +// the global color table is only valid if a flag is set in the logical +// screen descriptor. if the flag is set, the global color table will +// immediately follow the logical screen descriptor + + rGlobalColorTable := -1; + if (rGlobalColorValid) then // a global color table? + ReadColorTable(rGlobalColorSize, rGlobalColorTable) + end; +end; + +{ ---------------------------------------------------------------------------- } +{ read in any type of color table } +{ number of RGB entries is given by SIZE, and save the index into the } +{ master color table list in TABLE } +{ if SIZE is <= 0, then there is no table, and the TABLE becomes -1 } + +procedure TGif.ReadColorTable(Size: integer; var Table: integer); +var + i,n: integer; + r,g,b: byte; + ct: PGifColorTable; +begin +Table := -1; // assume no table +if (Size > 0) then // OK, a table does exist + begin + new(ct); // make a anew color table + if (ct = nil) then OutOfMemoryError; + n := fColorTableList.Add(ct); // save it in master list + Table := n; // save index for a valid table + + ct^.rSize := Size; + + for i := 0 to (ct^.rSize-1) do // read a triplet for each TColor + begin + fIOStream.Read(r, 1); // red + fIOStream.Read(g, 1); // green + fIOStream.Read(b, 1); // blue + + ct^.rColors[i] := r or (g shl 8) or (b shl 16); + end; + +// make sure we store palette handle in same index slot as the color table + + while (fPaletteList.Count < fColorTableList.Count) do fPaletteList.Add(nil); + fPaletteList.Items[Table] := Nil; + end; +end; + +{ ---------------------------------------------------------------------------- } +{ read the next image descriptor } +{ the source stream position should be immediately following the } +{ special code image separator } +{ note: this routine only reads in the raw data; the LZW de-compression } +{ occurs later, after all the data has been read } +{ this probably makes for a bigger data chunk, but it doesn't much effect } +{ the speed, and it is certainly a more modular approach and is much easier } +{ to understand the mechanics later } + +procedure TGif.ReadImageDescriptor; +var + i,n: integer; + ix: integer; + id: PGifImageDescriptor; + db: TGifDataBlock; +begin + +// make a new image desctiptor record and add this record to main list + +new(id); +if (id = nil) then OutOfMemoryError; +if (fImageDescriptorList = nil) then fImageDescriptorList := TList.Create; +ix := fImageDescriptorList.Add(id); +id^.rIndex := ix; + +// initialize data + +fillchar(id^, sizeof(TGifImageDescriptor), 0); + +// init the sotrage for compressed data + +fDataStream.Clear; + +// if extensions were read in earlier, save that list +// for this image descriptor +// if no extensions were read in, then we don't need this list at all + +if (fExtension <> nil) then + begin + id^.rExtensionList := fExtension; + fExtension := nil; + end; + +// shortcut to the record fields + +with id^ do + begin + +// read the basic descriptor record + + ReadSourceInteger(2, rLeft); // left position + ReadSourceInteger(2, rTop); // top position + ReadSourceInteger(2, rWidth); // size of image + ReadSourceInteger(2, rHeight); // size of image + + ReadSourceInteger(1, n); // packed bit field + rLocalColorValid := ((n and $80) <> 0); + rInterlaced := ((n and $40) <> 0); + rSorted := ((n and $20) <> 0); + + i := (n and $07); + if (i = 0) then rLocalColorSize := 2 + else if (i = 1) then rLocalColorSize := 4 + else if (i = 2) then rLocalColorSize := 8 + else if (i = 3) then rLocalColorSize := 16 + else if (i = 4) then rLocalColorSize := 32 + else if (i = 5) then rLocalColorSize := 64 + else if (i = 6) then rLocalColorSize := 128 + else if (i = 7) then rLocalColorSize := 256 + else rLocalColorSize := 256; + + +// if a local color table is defined, read it +// otherwise, use the global color table + + if (rLocalColorValid) then ReadColorTable(rLocalColorSize, rLocalColorTable) + else rLocalColorTable := fScreenDescriptor^.rGlobalColorTable; + +// _something_ must have defined by now ... + + if (rLocalColorTable < 0) then GIF_Error(2); + +// the LZW minimum code size + + ReadSourceInteger(1, rLZWSize); + +// read data blocks until the end of the list + + ReadSourceInteger(1, db.rSize); + while (db.rSize > 0) do + begin + if fIOStream.Read(db.rData, db.rSize) < db.rSize then + Gif_Error(24); {LDB} + fDataStream.Write(db.rData, db.rSize); + ReadSourceInteger(1, db.rSize); + end; + +// save the pixel list + + rPixelCount := rWidth * rHeight; + rPixelList := allocmem(rPixelCount); + if (rPixelList = nil) then OutOfMemoryError; + +// uncompress the data and write the bitmap + + LZWDecode(id); + end; // with id^ +end; + + +{ ---------------------------------------------------------------------------- } +{ read in a group of data blocks until a zero-length block is found } +{ store the data on the give TList } + +procedure TGif.ReadDataBlockList(List: TList); +var + b: byte; + db: PGifDataBlock; + BytesRead: integer; +begin + +// read data blocks until the end of the list + +fIOStream.Read(b, 1); // size of next block +while (b > 0) do // more blocks to get? + begin + new(db); // new data block record + db^.rSize := b; + BytesRead := fIOStream.Read(db^.rData, db^.rSize); // read the data + List.Add(db); // save in given list + + if BytesRead < db^.rSize then + Gif_Error(24); {LDB} + fIOStream.Read(b, 1); // size of next block + end; +end; + + + +{ ---------------------------------------------------------------------------- } +{ read in any type of extension record } +{ assume that the source position is AFTER the extension separator, } +{ but BEFORE the specific extension label } +{ the extension record we read in is stored in the master extension } +{ list; however, the indexes for these exrtensions is stored in a } +{ temporary list which will be assigned to the next image descriptor } +{ record read in. this is because all extension blocks preceed the } +{ image descriptor to which they belong } + +procedure TGif.ReadExtension(var Done: boolean); +var + n: integer; + b: byte; + eb: PGifExtension; +begin + +// make a list exists + +if (fExtension = nil) then fExtension := TList.Create; + +// make a new extension record and add it to temp holding list + +new(eb); +if (eb = nil) then OutOfMemoryError; +fillchar(eb^, sizeof(TGifExtension), 0); +fExtension.Add(eb); + +// get the type of extension + +fIOStream.Read(b, 1); +eb^.rLabel := b; + +// "with eb^" gives us access to rGraphic, rText, rComment, and rApp + +with eb^ do + begin + +// a graphic extension + + if (rLabel = kGifLabelGraphic) then + begin + ReadSourceInteger(1, rGraphic.rBlockSize); // block size + if (rGraphic.rBlockSize <> 4) then GIF_Error(5); + + ReadSourceInteger(1, n); // packed bit field + rGraphic.rDisposal := ((n shr 2) and $07); + rGraphic.rUserInputValid := ((n and $02) <> 0); + rGraphic.rTransparentValid := ((n and $01) <> 0); + + ReadSourceInteger(2, rGraphic.rDelayTime); // delay time + ReadSourceInteger(1, rGraphic.rTransparentIndex); // transparent color + ReadSourceInteger(1, n); // block terminator + if (n <> 0) then GIF_Error(7); + end + +// a comment extension + + else if (rLabel = kGifLabelComment) then + begin + rComment.rDataBlockList := TList.Create; + try + ReadDataBlockList(rComment.rDataBlockList); + except // Allow end of file in comment if at least one image {LDB} + if GetImageCount > 0 then + Done := True + else + Raise; + end; + end + +// a plain text extension + + else if (rLabel = kGifLabelText) then + begin + ReadSourceInteger(1, rText.rBlockSize); // block size + if (rText.rBlockSize <> 12) then GIF_Error(5); + ReadSourceInteger(2, rText.rGridLeft); // grid position + ReadSourceInteger(2, rText.rGridTop); // grid position + ReadSourceInteger(2, rText.rGridWidth); // grid size + ReadSourceInteger(2, rText.rGridHeight); // grid size + ReadSourceInteger(2, rText.rCellWidth); // character cell size + ReadSourceInteger(2, rText.rCellHeight); // character cell size + ReadSourceInteger(2, rText.rForegroundIndex); // foreground color + ReadSourceInteger(2, rText.rBackgroundIndex); // background color + rText.rDataBlockList := TList.Create; // list of text data blocks + ReadDataBlockList(rText.rDataBlockList); + end + +// an application extension + + else if (rLabel = kGifLabelApplication) then + begin + ReadSourceInteger(1, rApp.rBlockSize); // block size + if (rApp.rBlockSize <> 11) then GIF_Error(5); + fIOStream.Read(rApp.rIdentifier, 8); // application identifier + fIOStream.Read(rApp.rAuthentication, 3); // authentication code + rApp.rDataBlockList := TList.Create; + ReadDataBlockList(rApp.rDataBlockList); + if rApp.rIdentifier = 'NETSCAPE' then + ExtractLoopCount(rApp.rDataBlockList); + end + +// unknown type + + else + begin + GIF_ErrorMessage('unknown extension: ' + IntToHex(rLabel, 4)); + end; + end; // with eb^ +end; + + +{ ---------------------------------------------------------------------------- } +{ read a 1 or 2-byte integer from the source stream } + +procedure TGif.ReadSourceInteger(size: integer; var value: integer); +var + b: byte; + w: word; +begin +if (size = 1) then + begin + fIOStream.Read(b, 1); + value := b; + end +else if (size = 2) then + begin + fIOStream.Read(w, 2); + value := w; + end +else + begin + GIF_Error(8); + end; +end; + +{ ---------------------------------------------------------------------------- } +{ decode the compressed data blocks into a bitmap } + +procedure TGif.LZWDecode(pID: PGifImageDescriptor); +var + pc: integer; // next compressed code parsed from input + cc: integer; // current code to translate + oc: integer; // old code translated + tt: integer; // temp storage for OldCode + Done: boolean; +begin + +// init local data + +LZWInit(pID); +LZWReset; + +// do everything within the ZIP record + +with fZipData^ do + begin + +// parse next code from BitString + + pc := LZWGetCode; + oc := pc; + Done := False; + while (pc <> rEndCode) and not Done do + begin + +// reset decode parameters and save first code + + if (pc = rClearCode) then + begin + rCurSize := rID^.rLZWSize + 1; + rCurSlot := rEndCode + 1; + rTopSlot := (1 shl rCurSize); + while (pc = rClearCode) do pc := LZWGetCode; + if (pc = rEndCode) then GIF_Error(13); + if (pc >= rCurSlot) then pc := 0; + oc := pc; + LZWSaveCode(pc); + end + +// find a code in the table and write out translation + + else + begin + cc := pc; + if (cc < rCurSlot) then + begin + LZWDecodeCode(cc); + if (rCurSlot <= rTopSlot) then + begin + LZWSaveSlot(oc, cc); + oc := pc; + end; + LZWCheckSlot; + end + +// add a new code to the decode table + + else + begin + if (cc <> rCurSlot) then GIF_Error(13); + tt := oc; + while (oc > rHighCode) do oc := rPrefix[oc]; + if (rCurSlot <= rTopSlot) then LZWSaveSlot(tt, oc); + LZWCheckSlot; + LZWDecodeCode(cc); + oc := pc; + end; + end; + +// write out translated bytes to the image storage + + LZWWriteBitmap; + if fDataStream.Position < fDataStream.Size then + pc := LZWGetCode + else Done := True; + rMaxVal := false; + + end; // while not EOI + + end; // with + +// done with stack space + +LZWFinit; +end; + +{ ---------------------------------------------------------------------------- } + +procedure TGif.LZWInit(pID: PGifImageDescriptor); +begin + +// get a valid record? + +if (pID = nil) then GIF_Error(11); + +// make sure we can actually decode this turkey + +// if ((pID^.rLZWSize < 2) or (pID^.rLZWSize > 9)) then GIF_Error(12); + +// allocate stack space + +new(fZipData); +if (fZipData = nil) then OutOfMemoryError; + +// init data block + +fillchar(fZipData^, sizeof(TGifZip), 0); +fZipData^.rID := pID; +fZipData^.rCT := fColorTableList.Items[pID^.rLocalColorTable]; + +// reset data stream + +fDataStream.Position := 0; +end; + +{ ---------------------------------------------------------------------------- } + +procedure TGif.LZWFinit; +begin +if (fZipData <> nil) then dispose(fZipData); +fZipData := nil; +end; + +{ ---------------------------------------------------------------------------- } + +procedure TGif.LZWReset; +var + i: integer; +begin +with fZipData^ do + begin + for i := 0 to (kGifCodeTableSize - 1) do + begin + rPrefix[i] := 0; + rSuffix[i] := 0; + end; + + rCurSize := rID^.rLZWSize + 1; + rClearCode := (1 shl rID^.rLZWSize); + rEndCode := rClearCode + 1; + rHighCode := rClearCode - 1; + rFirstSlot := (1 shl (rCurSize - 1)) + 2; + rNextSlot := rFirstSlot; + rMaxVal := false; + end; // with +end; + + +{ ---------------------------------------------------------------------------- } +{ get the next code from the BitString } +{ CurrentSize specifies the number of bits to get } + +function TGif.LZWGetCode: integer; +var + n: integer; + cc: integer; + mask: integer; + b: byte; +begin +with fZipData^ do + begin + +// make sure we have enough bits + + while (rCurSize > rBits) do + begin + if (fDataStream.Position >= fDataStream.Size) then + b := 0 + else + fDataStream.Read(b, 1); + n := b; + n := (n shl rBits); // scoot bits over to avoid previous data + rBitString := (rBitString or n); // put bits in the BitString + rBits := rBits + 8; // number of bits in a byte + end; + + +// get the code, then dump the bits we used from the BitString + + case rCurSize of + 0: mask := 0; + 1: mask := $0001; + 2: mask := $0003; + 3: mask := $0007; + 4: mask := $000f; + 5: mask := $001f; + 6: mask := $003f; + 7: mask := $007f; + 8: mask := $00ff; + 9: mask := $01ff; + 10: mask := $03ff; + 11: mask := $07ff; + 12: mask := $0fff; + else + begin + GIF_Error(12); + Mask := 0; //stop warning + end; + end; + + cc := (rBitString and mask); // mask off bits wanted + rBitString := (rBitString shr rCurSize); // delete bits we just took + rBits := rBits - rCurSize; // number of bits left in BitString + end; // with + +// done + +LZWGetCode := cc; +end; + +{ ---------------------------------------------------------------------------- } +{ save a code value on the code stack } + +procedure TGif.LZWSaveCode(Code: integer); +begin +with fZipData^ do + begin + rCodeStack[rSP] := Code; + rSP := rSP + 1; + end; +end; + + +{ ---------------------------------------------------------------------------- } +{ decode the CurrentCode into the clear-text pixel value } +{ mainly, just save the CurrentCode on the output stack, along with } +{ whatever prefixes go with it } + +procedure TGif.LZWDecodeCode(var Code: integer); +begin +with fZipData^ do + begin + while (Code > rHighCode) do + begin + LZWSaveCode(rSuffix[Code]); + Code := rPrefix[Code]; + end; + LZWSaveCode(Code); + end; +end; + + +{ ---------------------------------------------------------------------------- } +{ save a new prefix/suffix pair } + +procedure TGif.LZWSaveSlot(Prefix, Suffix: integer); +begin +with fZipData^ do + begin + rPrefix[rCurSlot] := Prefix; + rSuffix[rCurSlot] := Suffix; + rCurSlot := rCurSlot + 1; + end; +end; + + + +{ ---------------------------------------------------------------------------- } +{ given current line number, compute the next line to be filled } +{ this gets a little tricky if an interlaced image } +{ what is the purpose of this interlace, anyway? it doesn't save space, } +{ and I can't imagine it makes for any faster image disply or loading } + +procedure TGif.LZWIncrPosition; +var + n: integer; +begin +with fZipData^ do + begin + +// if first pass, make sure CurPass was initialized + + if (rCurPass = 0) then rCurPass := 1; + +// incr X position + + rCurX := rCurX + 1; + +// bumping Y ? + + if (rCurX >= rID^.rWidth) then + begin + rCurX := 0; + +// if not interlaced image, then just move down the page + + if (not rID^.rInterlaced) then + begin + rCurY := rCurY + 1; + end + +// interlaced images select the next line by some archane black-magical sheme + + else + begin + case rCurPass of // delta to next row on this pass + 1: n := 8; + 2: n := 8; + 3: n := 4; + 4: n := 2; + else + begin + GIF_Error(21); + n := 0; //prevent warning + end; + end; + + rCurY := rCurY + n; + +// if past the end of the bitmap, start next pass + + if (rCurY >= rID^.rHeight) then + begin + rCurPass := rCurPass + 1; + if (rCurPass = 5) then rCurPass := 1; + case rCurPass of // first line for given pass + 1: n := 0; + 2: n := 4; + 3: n := 2; + 4: n := 1; + else GIF_Error(21); + end; + + rCurY := n; + end; + end; + end; + end; // with +end; + +{ ---------------------------------------------------------------------------- } +{ see if it is time to add a new slot to the decoder tables } + +procedure TGif.LZWCheckSlot; +begin +with fZipData^ do + begin + if (rCurSlot >= rTopSlot) then + begin + if (rCurSize < 12) then + begin + rTopSlot := (rTopSlot shl 1); + rCurSize := rCurSize + 1; + end + else + begin + rMaxVal := true; + end; + end; + end; +end; + +{ ---------------------------------------------------------------------------- } +{ empty the Codes stack and write to the Bitmap } + +procedure TGif.LZWWriteBitmap; +var + i,n: integer; + j: longint; + p: PChar; +begin +with fZipData^ do + begin + for n := (rSP - 1) downto 0 do + begin + rCount := rCount + 1; + +// get next code from the stack, and index into PixelList + + i := rCodeStack[n]; + j := (rCurY * rID^.rWidth) + rCurX; + if ((0 <= j) and (j < rID^.rPixelCount)) then + begin + +// store the pixel index into PixelList + + p := rID^.rPixelList + j; + p^ := chr(i); + end; + + LZWIncrPosition; + end; + + rSP := 0; + end; // with +end; + +{ ---------------------------------------------------------------------------- } +{ get the next pixel from the bitmap, and return it as an index into } +{ the colormap } + +function TGif.LZWReadBitmap: integer; +var + n: integer; + j: longint; + p: PChar; +begin +with fZipData^ do + begin + if (rUnget) then + begin + n := rLast; + rUnget := false; + end + else + begin + rCount := rCount + 1; + j := (rCurY * rID^.rWidth) + rCurX; + if ((0 <= j) and (j < rID^.rPixelCount)) then + begin + p := rID^.rPixelList + j; + n := ord(p^); + end + else + begin + n := 0; + end; + + LZWIncrPosition; + end; + + rLast := n; + end; // with + +LZWReadBitmap := n; +end; + +{ ---------------------------------------------------------------------------- } +{ PROCEDURES TO IMPLEMENT PROPERTIES ----------------------------------------- } + +{ ---------------------------------------------------------------------------- } + +function TGif.GetSignature: string; +var + s: string; +begin +s := fSignature^.rSignature; +GetSignature := s; +end; + + +{ ---------------------------------------------------------------------------- } +{ return screen descriptor data pointer, or set a new record block } + +function TGif.GetScreenDescriptor: PGifScreenDescriptor; +begin +GetScreenDescriptor := fScreenDescriptor; +end; + + +{ ---------------------------------------------------------------------------- } + +function TGif.GetImageCount: integer; +begin +GetImageCount := fImageDescriptorList.Count; +end; + + +function TGif.GetImageDescriptor(image: integer): PGifImageDescriptor; +begin +if ((image < 0) or (image >= fImageDescriptorList.Count)) then GIF_Error(15); +GetImageDescriptor := fImageDescriptorList.Items[image]; +end; + + +{ ---------------------------------------------------------------------------- } + +function TGif.GetBitmap(image: integer): TBitmap; +var + p: PGifImageDescriptor; + b: TBitmap; +begin +p := GetImageDescriptor(image); +if (p^.rBitmap = nil) then MakeBitmaps; +b := p^.rBitmap; + +GetBitmap := b; +end; + +{ ---------------------------------------------------------------------------- } + +function TGif.GetColorTableCount: integer; +begin +GetColorTableCount := fColorTableList.Count; +end; + + +function TGif.GetColorTable(table: integer): PGifColorTable; +begin +if ((table < 0) or (table >= fColorTableList.Count)) then GIF_Error(15); +GetColorTable := fColorTableList.Items[table]; +end; + +function TGif.GetImageDelay(Image: integer): integer; +var + gx: PGifExtensionGraphic; +begin +gx := FindGraphicExtension(Image); +if (gx <> nil) then + begin + Result := gx^.rDelayTime; + if Result < 1 then + Result := 1; + end +else Result := 1; +end; + +function TGif.GetImageDisposal(Image: integer): integer; +var + gx: PGifExtensionGraphic; +begin +gx := FindGraphicExtension(Image); +if (gx <> nil) then + Result := gx^.rDisposal and 3 +else Result := 0; +end; + +{ ---------------------------------------------------------------------------- } + +function TGif.GetColorIndex(image, x, y: integer): integer; +var + i,n: integer; + id: PGifImageDescriptor; + p: PChar; +begin +if ((image < 0) or (image >= fImageDescriptorList.Count)) then GIF_Error(15); +id := fImageDescriptorList.Items[image]; +if ((x < 0) or (x >= id^.rWidth)) then GIF_Error(15); +if ((y < 0) or (y >= id^.rHeight)) then GIF_Error(15); + +n := (y * id^.rWidth) + x; +p := id^.rPixelList + n; +i := ord(p^); + +GetColorIndex := i; +end; + +{ ---------------------------------------------------------------------------- } +{ transparent color for each individual image. + returns -1 if none. } + +function TGif.GetTransparentIndex(image: integer): integer; +var + i: integer; + gx: PGifExtensionGraphic; +begin +i := -1; +gx := FindGraphicExtension(image); +if (gx <> nil) and (gx^.rTransparentValid) then {LDB} + i := gx^.rTransparentIndex; + +GetTransparentIndex := i; +end; + +{ ---------------------------------------------------------------------------- } +{ transparent color for all images } +{LDB Changed to always return the standard used for the transparent color} + +function TGif.GetTransparentColor: TColor; +begin +GetTransparentColor := TransColor; +end; + +procedure TGif.ExtractLoopCount(List: TList); +begin +if List.Count > 0 then + with PGifDataBlock(List[0])^ do + if rSize = 3 then + FLoopCount := rData[2] + rData[3]*256; +end; + +{ ---------------------------------------------------------------------------- } + +function TGif.GetImageLeft(image: integer): integer; +var + id: PGifImageDescriptor; +begin +id := GetImageDescriptor(image); +GetImageLeft := id^.rLeft; +end; + +function TGif.GetImageTop(image: integer): integer; +var + id: PGifImageDescriptor; +begin +id := GetImageDescriptor(image); +GetImageTop := id^.rTop; +end; + +function TGif.GetImageWidth(image: integer): integer; +var + id: PGifImageDescriptor; +begin +id := GetImageDescriptor(image); +GetImageWidth := id^.rWidth; +end; + +function TGif.GetImageHeight(image: integer): integer; +var + id: PGifImageDescriptor; +begin +id := GetImageDescriptor(image); +GetImageHeight := id^.rHeight; +end; + +function TGif.GetImageDepth(image: integer): integer; +var + id: PGifImageDescriptor; + ct: PGifColorTable; +begin +id := GetImageDescriptor(image); +ct := fColorTableList.Items[id^.rLocalColorTable]; +GetImageDepth := ct^.rSize; +end; + + +{ ---------------------------------------------------------------------------- } +{ GENERAL INTERNAL ROUTINES -------------------------------------------------- } + +{ ---------------------------------------------------------------------------- } + +procedure TGif.FreeDataBlockList(var list: TList); +var + i: integer; + db: PGifDataBlock; +begin +if (list <> nil) then + begin + for i := 0 to (list.Count - 1) do + begin + db := list.Items[i]; + if (db <> nil) then dispose(db); + end; + + list.Free; + end; + +list := nil; +end; + +{ ---------------------------------------------------------------------------- } + +procedure TGif.FreeExtensionList(var list: TList); +var + i: integer; + ex: PGifExtension; +begin +if (list <> nil) then + begin + for i := 0 to (list.Count - 1) do + begin + ex := list.Items[i]; + if (ex <> nil) then + begin + if (ex^.rLabel = kGifLabelComment) then FreeDataBlockList(ex^.rComment.rDataBlockList) + else if (ex^.rLabel = kGifLabelText) then FreeDataBlockList(ex^.rText.rDataBlockList) + else if (ex^.rLabel = kGifLabelApplication) then FreeDataBlockList(ex^.rApp.rDataBlockList); + + dispose(ex); + end; + end; + + list.Free; + end; + +list := nil; +end; + + +{ ---------------------------------------------------------------------------- } +{ after an image has been LZW decoded, write a bitmap from the string of pixels } + +{----------------TGif.MakeBitmaps} +procedure TGif.MakeBitmaps; +type + LayoutType = Packed Record + BFH: TBitmapFileHeader; + BIH: TBitmapInfoHeader; + end; + PLayoutType = ^LayoutType; +var + id: PGifImageDescriptor; + ct: PGifColorTable; + FullWidth, PixelSize, FileSize: integer; + Stream: TMemoryStream; + PL: PLayoutType; + Color: TColor; + Index: integer; + Pix, P: PChar; + I, X, Y, N: integer; + TrIndex: integer; +begin +for i := 0 to (fImageDescriptorList.Count - 1) do + begin + id := fImageDescriptorList.Items[i]; + if ((id <> nil) and (id^.rBitmap = nil)) then // don't do it again + with id^ do + begin + FullWidth := rWidth * 3; + if FullWidth and $3 <> 0 then + FullWidth := (FullWidth and $FFFFFFFC) + $4; + PixelSize := FullWidth * rHeight; + FileSize := Sizeof(LayoutType)+PixelSize; + Stream := TMemoryStream.Create; + try + Stream.Size := FileSize; + PL := Stream.Memory; + FillChar(PL^, FileSize, 0); + + with PL^.BFH do + begin + bfType := 19778; + bfSize := FileSize; + bfReserved1 := 0; + bfReserved2 := 0; + bfOffBits := Sizeof(LayoutType); + end; + with PL^.BIH do + begin + biSize := Sizeof(TBitmapInfoHeader); + biWidth := rWidth; + biHeight := rHeight; + biPlanes := 1; + biBitCount := 24; + biCompression := 0; + biSizeImage := 0; + biXPelsPerMeter := 0; + biYPelsPerMeter := 0; + biClrUsed := 0; + biClrImportant := 0; + end; + + ct := fColorTableList.Items[rLocalColorTable]; + TrIndex := GetTransparentIndex(i); + if (TrIndex >= 0) and (TrIndex < ct^.rSize) then + {change transparent color to something that won't likely match any other color} + ct^.rColors[TrIndex] := TransColor; + + N := 0; + Pix := PChar(PL) + Sizeof(LayoutType); + for Y := rHeight-1 downto 0 do + begin + P := Pix + (Y * FullWidth); + for X := 0 to rWidth-1 do + begin + Index := Integer((rPixelList + N)^); + Color := ct^.rColors[Index]; + P^ := Char((Color shr 16) and $FF); + Inc(P); + P^ := Char((Color shr 8) and $FF); + Inc(P); + P^ := Char(Color and $FF); + Inc(P); + Inc(N); + end; + end; + rBitmap := TBitmap.Create; + {$ifndef UseCLX} + rBitmap.HandleType := bmDIB; + {$endif} + rBitmap.LoadFromStream(Stream); + finally + Stream.Free; + end; + +// is bitmap transparent? + + if ((0 <= TrIndex) and (TrIndex < ct^.rSize)) then + begin + rBitmap.Transparent := true; + rBitmap.TransparentMode := tmFixed; + rBitmap.TransparentColor := ct^.rColors[TrIndex]; + end; + end; + end; +end; + +{----------------TGif.GetStripBitmap} +function TGif.GetStripBitmap(var Mask: TBitmap): TBitmap; {LDB} +{This is a single bitmap containing all the frames. A mask is also provided + if the GIF is transparent. Each Frame is setup so that it can be transparently + blted to a background.} +type + LayoutType = Packed Record + BFH: TBitmapFileHeader; + BIH: TBitmapInfoHeader; + end; + PLayoutType = ^LayoutType; +var + id: PGifImageDescriptor; + ct: PGifColorTable; + FullWidth, PixelSize, FileSize: integer; + Stream, MStream: TMemoryStream; + PL, MPL: PLayoutType; + Color: TColor; + Index: integer; + Pix, P, MPix, MP: PChar; + I, X, Y, N: integer; + TrIndex: integer; + C: char; + IsTransparent: boolean; +begin +MStream := Nil; +Result := Nil; +Mask := Nil; +MP := Nil; +MPix := Nil; +{find size needed for strip bitmap} +FullWidth := Width * 3 * ImageCount; {3 bytes per pixel} +if FullWidth and $3 <> 0 then {make sure it is DWord boundary} + FullWidth := (FullWidth and $FFFFFFFC) + $4; +PixelSize := FullWidth * Height; +FileSize := Sizeof(LayoutType)+PixelSize; +Stream := TMemoryStream.Create; +try + Stream.Size := FileSize; + PL := Stream.Memory; + FillChar(PL^, FileSize, 0); + + with PL^.BFH do + begin {set up the bitmap file header} + bfType := 19778; + bfSize := FileSize; + bfReserved1 := 0; + bfReserved2 := 0; + bfOffBits := Sizeof(LayoutType); + end; + with PL^.BIH do + begin {and the bitmap info header} + biSize := Sizeof(TBitmapInfoHeader); + biWidth := Width * ImageCount; + biHeight := Height; + biPlanes := 1; + biBitCount := 24; {will use 24 bit pixel} + biCompression := 0; + biSizeImage := 0; + biXPelsPerMeter := 0; + biYPelsPerMeter := 0; + biClrUsed := 0; + biClrImportant := 0; + end; + + Pix := PChar(PL) + Sizeof(LayoutType); {where pixels start} + + IsTransparent := Transparent; + if IsTransparent then + begin {set up a maxk similarly} + MStream := TMemoryStream.Create; + MStream.Size := FileSize; + MPL := MStream.Memory; + Move(PL^, MPL^, FileSize); {for now, this is a direct copy} + MPix := PChar(MPL) + Sizeof(LayoutType); {where mask pixels start} + end; + + for i := 0 to (fImageDescriptorList.Count - 1) do {for all the frames} + begin + id := fImageDescriptorList.Items[i]; + if (id <> nil) then + with id^ do + begin + ct := fColorTableList.Items[rLocalColorTable]; + TrIndex := GetTransparentIndex(i); + + N := 0; {pixel index in rPixelList, the frame source pixels} + for Y := Height-1 downto Height-rHeight do + begin + {find the start of each frame row in destination. Note that the source + frame may be smaller than the destination and positioned according to + imagetop and imageleft} + P := Pix + ((Y-ImageTop[i]) * FullWidth) + i*Width*3 +ImageLeft[i]*3; + if IsTransparent then {same for mask} + MP := MPix + ((Y-ImageTop[i]) * FullWidth) + i*Width*3 +ImageLeft[i]*3; + for X := 0 to rWidth-1 do + begin + Index := Integer((rPixelList + N)^); {Source pixel index in colortable} + Color := ct^.rColors[Index]; {its color} + {for frames after the 0th, only the non transparent pixels are written + as writing transparent ones might cover results copied from the previous frame} + if (Index <> trIndex) then + begin + P^ := Char((Color shr 16) and $FF); + Inc(P); + P^ := Char((Color shr 8) and $FF); + Inc(P); + P^ := Char(Color and $FF); + Inc(P); + end + else if i = 0 then + begin {transparent pixel, first frame, write black} + P^ := #0; + Inc(P); + P^ := #0; + Inc(P); + P^ := #0; + Inc(P); + end + else Inc(P, 3); {ignore transparent pixel} + if IsTransparent then {also do the mask} + begin + if Index = trIndex then + C := #$FF {transparent part is white} + else C := #0; {non transparent is black} + {again for frames after the 0th, only non-transparent pixels are written} + if (i = 0) or (C = #0) then + begin + MP^ := C; + Inc(MP); + MP^ := C; + Inc(MP); + MP^ := C; + Inc(MP); + end + else Inc(MP, 3); + end; + Inc(N); {bump source pixel index} + end; + end; + end; + {Now copy this frame to the next (unless it the last one). This serves as a + background for the next image. This is all that's needed for the dtDoNothing + disposal method but will be fixed up for dtBackground below} + if (i < fImageDescriptorList.Count-1) then + begin + for Y := Height-1 downto 0 do + begin {copy line by line} + P := Pix + (Y * FullWidth) + i*Width*3; + if IsTransparent then + MP := MPix + (Y * FullWidth) + i*Width*3; + Move(P^, (P+Width*3)^, Width*3); + if IsTransparent then + Move(MP^, (MP+Width*3)^, Width*3); + end; + {for dtBackground, fill the mask area occupied by the current copied image with + white. This makes it transparent so the original background will appear here + (although the next image will no doubt write on part of this area.} + if IsTransparent and (ImageDisposal[i] = 2) then + with id^ do + for Y := Height-1 downto Height-rHeight do + begin + MP := MPix + ((Y-ImageTop[i]) * FullWidth) + (i+1)*Width*3 +ImageLeft[i]*3; + FillChar(MP^, rWidth*3, $FF); + end; + end; + end; + + Result := TBitmap.Create; + {$ifndef UseCLX} + Result.HandleType := bmDIB; + {$endif} + Result.LoadFromStream(Stream); {turn the stream just formed into a TBitmap} + if IsTransparent then + begin + Mask := TBitmap.Create; + Mask.HandleType := bmDIB; + Mask.LoadFromStream(MStream); + Mask.Monochrome := True; {crunch mask into a monochrome TBitmap} + end; + Stream.Free; + MStream.Free; +except + Stream.Free; + MStream.Free; + Mask.Free; + Result.Free; + Raise; + end; +end; + +{ ---------------------------------------------------------------------------- } +{ find the graphic extension for an image } + +function TGif.FindGraphicExtension(image: integer): PGifExtensionGraphic; +var + n: integer; + id: PGifImageDescriptor; + ex: PGifExtension; + gx: PGifExtensionGraphic; +begin +gx := nil; +id := fImageDescriptorList.Items[image]; +if (id^.rExtensionList <> nil) then + begin + for n := 0 to (id^.rExtensionList.Count - 1) do + begin + ex := id^.rExtensionList.Items[n]; + if ((ex^.rLabel = kGifLabelGraphic) and (gx = nil)) then + begin + gx := @(ex^.rGraphic); + end; + end; + end; + +FindGraphicExtension := gx; +end; + +{ ---------------------------------------------------------------------------- } +{ find the color within the color table; returns 0..255 } +{ return -1 if color not found } + +function TGif.FindColorIndex(c: TColor; ct: PGifColorTable): integer; +var + i,n: integer; +begin +n := -1; +for i := 0 to (ct^.rSize - 1) do + begin + if ((n < 0) and (ct^.rColors[i] = c)) then n := i; + end; + +FindColorIndex := n; +end; + +{ ---------------------------------------------------------------------------- } +{ RAISE AN ERROR ------------------------------------------------------------- } + +procedure GIF_Error(n: integer); +begin +GIF_ErrorCode := n; +GIF_ErrorString := kGifErrorMessages[n]; +raise EInvalidGraphicOperation.CreateFmt('TGif: %s', [GIF_ErrorString]); +end; + + +procedure GIF_ErrorMessage(m: string); +begin +GIF_ErrorCode := 6; +GIF_ErrorString := m; +raise EInvalidGraphicOperation.CreateFmt('TGif: %s', [GIF_ErrorString]); +end; + +end. diff --git a/components/htmllite/litegif2.pas b/components/htmllite/litegif2.pas new file mode 100644 index 0000000000..72e9afc08d --- /dev/null +++ b/components/htmllite/litegif2.pas @@ -0,0 +1,641 @@ +{Version 9.03} +{*********************************************************} +{* LITEGIF2.PAS *} +{* Copyright (c) 2001-2002 by *} +{* L. David Baldwin *} +{* All rights reserved. *} +{*********************************************************} + +{$i litecons.inc} + +unit LiteGIF2; + +{$ifndef NoGIF} + +interface + +uses + Windows, SysUtils, Classes, Graphics, Controls, ExtCtrls, LiteUN2, mmSystem, + litegif1; + +type + TRGBColor = packed Record + Red, + Green, + Blue: Byte; + end; + + TDisposalType = (dtUndefined, {Take no action} + dtDoNothing, {Leave graphic, next frame goes on top of it} + dtToBackground,{restore original background for next frame} + dtToPrevious); {restore image as it existed before this frame} + +type + ThtBitmap=class(TBitmap) + protected + htMask: TBitmap; + htTransparent: boolean; + procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; + procedure StretchDraw(ACanvas: TCanvas; const DestRect, + SrcRect: TRect); + public + destructor Destroy; override; + end; + + TGIFImage = class; + + TgfFrame = class + private + { private declarations } + frLeft: Integer; + frTop: Integer; + frWidth: Integer; + frHeight: Integer; + + frDelay: Integer; + frDisposalMethod: TDisposalType; + TheEnd: boolean; {end of what gets copied} + + IsCopy: boolean; + + Public + constructor Create; + constructor CreateCopy(Item: TgfFrame); + destructor Destroy; override; + end; + + TgfFrameList = class(TList) + private + function GetFrame(I: integer): TgfFrame; + public + {note: Frames is 1 based, goes from [1..Count]} + property Frames[I: integer]: TgfFrame read GetFrame; default; + end; + + TGIFImage = class(TPersistent) + private + { Private declarations } + FAnimated: Boolean; + FCurrentFrame: Integer; + FImageWidth: Integer; + FImageHeight: Integer; + FNumFrames: Integer; + FNumIterations: Integer; + FTransparent: Boolean; + FVisible: Boolean; + Strip: ThtBitmap; + + TheEnd: boolean; {copy to here} + + FBitmap: TBitmap; + FMaskedBitmap, FMask: TBitmap; + FAnimate: Boolean; + FStretchedRect: TRect; + WasDisposal: TDisposalType; + + Frames: TgfFrameList; + + CurrentIteration: Integer; + LastTime: DWord; + CurrentInterval: DWord; + + procedure SetAnimate(AAnimate: Boolean); + procedure SetCurrentFrame(AFrame: Integer); + function GetMaskedBitmap: TBitmap; + function GetMask: TBitmap; + function GetBitMap: TBitmap; + + procedure NextFrame(OldFrame: Integer); + + public + ShowIt: boolean; + IsCopy: boolean; {set if this is a copy of one in Cache} + + { Public declarations } + constructor Create; + constructor CreateCopy(Item: TGIFImage); + destructor Destroy; override; + procedure Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer); + property Bitmap: TBitmap read GetBitmap; + property MaskedBitmap: TBitmap read GetMaskedBitmap; + property Mask: TBitmap read GetMask; + property IsAnimated: Boolean read FAnimated; + property IsTransparent: Boolean read FTransparent; + property NumFrames: Integer read FNumFrames; + property NumIterations: Integer read FNumIterations; + + procedure CheckTime(WinControl: TWinControl); + + property Width: integer read FImageWidth; + property Height: integer read FImageHeight; + property Animate: Boolean read FAnimate write SetAnimate; + property CurrentFrame: Integer read FCurrentFrame write SetCurrentFrame; + property Visible: Boolean read FVisible write FVisible; + end; + +function CreateAGifFromStream(var NonAnimated: boolean; + Stream: TStream): TGifImage; +function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage; + +implementation + +uses + litesubs; + +function CreateBitmap(Width, Height: integer): TBitmap; +begin +Result := TBitmap.Create; +Result.Width := Width; +Result.Height := Height; +end; + +function CreateAGifFromStream(var NonAnimated: boolean; + Stream: TStream): TGifImage; +var + AGif: TGif; + Frame: TgfFrame; + I: integer; + ABitmap, AMask: TBitmap; +begin +Result := Nil; +try + NonAnimated := True; + AGif := TGif.Create; + Try + AGif.LoadFromStream(Stream); + Result := TGifImage.Create; + + Result.FNumFrames := AGif.ImageCount; + Result.FAnimated := Result.FNumFrames > 1; + NonAnimated := not Result.FAnimated; + Result.FImageWidth := AGif.Width; + Result.FImageHeight := AGif.Height; + Result.FNumIterations:= AGif.LoopCount; + if Result.FNumIterations <= 0 then + Result.FNumIterations := 0; {loop forever} + Result.FTransparent := AGif.Transparent; + + with Result do + begin + Strip := ThtBitmap.Create; + ABitmap := AGif.GetStripBitmap(AMask); + try + Strip.Assign(ABitmap); + Strip.htMask := AMask; + Strip.htTransparent := Assigned(AMask); + finally + ABitmap.Free; + end; + DeleteObject(Result.Strip.ReleasePalette); + Result.Strip.Palette := CopyPalette(ThePalette); + end; + + for I := 0 to Result.FNumFrames-1 do + begin + Frame := TgfFrame.Create; + try + Frame.frDisposalMethod := TDisposalType(AGif.ImageDisposal[I]); + Frame.frLeft := AGif.ImageLeft[I]; + Frame.frTop := AGif.ImageTop[I]; + Frame.frWidth := AGif.ImageWidth[I]; + Frame.frHeight := AGif.ImageHeight[I]; + Frame.frDelay := IntMax(30, AGif.ImageDelay[I] * 10); + except + Frame.Free; + Raise; + end; + Result.Frames.Add(Frame); + end; + if Result.IsAnimated then + Result.WasDisposal := dtToBackground; + finally + AGif.Free; + end; +except + FreeAndNil(Result); + end; +end; + +function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage; +var + Stream: TFileStream; +begin +Result := Nil; +try + Stream := TFileStream.Create(Name, fmOpenRead or fmShareDenyWrite); + try + Result := CreateAGifFromStream(NonAnimated, Stream); + finally + Stream.Free; + end; +except + end; +end; + +{----------------TgfFrame.Create} +constructor TgfFrame.Create; +begin +inherited Create; +end; + +constructor TgfFrame.CreateCopy(Item: TgfFrame); +begin +inherited Create; +System.Move(Item.frLeft, frLeft, DWord(@TheEnd)-DWord(@frLeft)); +IsCopy := True; +end; + +{----------------TgfFrame.Destroy} +destructor TgfFrame.Destroy; +begin +inherited Destroy; +end; + +{----------------TGIFImage.Create} +constructor TGIFImage.Create; +begin + inherited Create; + FVisible := True; + FCurrentFrame := 1; + Frames := TgfFrameList.Create; +end; + +constructor TGIFImage.CreateCopy(Item: TGIFImage); +var + I: integer; +begin +inherited Create; +FImageWidth := Item.Width; +FimageHeight := Item.Height; +System.Move(Item.FAnimated, FAnimated, DWord(@TheEnd)-DWord(@FAnimated)); +IsCopy := True; + +Frames := TgfFrameList.Create; +for I := 1 to FNumFrames do + Frames.Add(TgfFrame.CreateCopy(Item.Frames[I])); +FCurrentFrame := 1; +CurrentIteration := 1; +if FAnimated then + WasDisposal := dtToBackground; +end; + +{----------------TGIFImage.Destroy} +destructor TGIFImage.Destroy; +var + I: Integer; +begin +for I := Frames.Count downto 1 do + Frames[I].Free; +Frames.Free; +FreeAndNil(FBitmap); +if not IsCopy then + FreeAndNil(Strip); +FMaskedBitmap.Free; +FreeAndNil(FMask); +inherited Destroy; +end; + +{----------------TGIFImage.Draw} +procedure TGIFImage.Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer); +var + SRect: TRect; + ALeft: integer; +begin +FStretchedRect := Rect(X, Y, X+Wid, Y+Ht); + +SetStretchBltMode(Canvas.Handle, ColorOnColor); +if (FVisible) and (FNumFrames > 0) then + begin + with Frames[FCurrentFrame] do + begin + ALeft := (FCurrentFrame-1)*Width; + SRect := Rect(ALeft, 0, ALeft+Width, Height); {current frame location in Strip bitmap} + end; + + Canvas.CopyMode := cmSrcCopy; + {draw the correct portion of the strip} + Strip.StretchDraw(Canvas, FStretchedRect, SRect); + end; +end; + +{----------------TGifImage.CheckTime} +procedure TGifImage.CheckTime(WinControl: TWinControl); +var + ThisTime: DWord; +begin +if not FAnimate then Exit; + +ThisTime := timeGetTime; +if ThisTime - LastTime < CurrentInterval then + Exit; + +LastTime := ThisTime; + +if (FCurrentFrame = FNumFrames) then + begin + if (FNumIterations > 0) and (CurrentIteration >= FNumIterations) then + begin + SetAnimate(False); + Exit; + end; + Inc(CurrentIteration); + end; +NextFrame(FCurrentFrame); +Inc(FCurrentFrame); +if (FCurrentFrame > FNumFrames) or (FCurrentFrame <= 0) then + FCurrentFrame := 1; + +InvalidateRect(WinControl.Handle, @FStretchedRect, True); + +CurrentInterval := IntMax(Frames[FCurrentFrame].frDelay, 1); +end; + +{----------------TGIFImage.SetAnimate} +procedure TGIFImage.SetAnimate(AAnimate: Boolean); +begin + if AAnimate = FAnimate then Exit; + + FAnimate := AAnimate; + CurrentIteration := 1; + if AAnimate and (FNumFrames > 1) then + begin + CurrentInterval := IntMax(Frames[FCurrentFrame].frDelay, 1); + LastTime := timeGetTime; + end; +end; + +{----------------TGIFImage.SetCurrentFrame} +procedure TGIFImage.SetCurrentFrame(AFrame: Integer); +begin +if AFrame = FCurrentFrame then Exit; + +NextFrame(FCurrentFrame); +if AFrame > FNumFrames then FCurrentFrame := 1 +else if AFrame < 1 then FCurrentFrame := FNumFrames +else FCurrentFrame := AFrame; +if FAnimated then + WasDisposal := dtToBackground; +end; + +{----------------TGIFImage.GetBitmap} +function TGIFImage.GetBitmap: TBitmap; +begin +Result := GetMaskedBitmap; +end; + +{----------------TGIFImage.GetMaskedBitmap:} +function TGIFImage.GetMaskedBitmap: TBitmap; +{This returns frame 1} +begin +if not Assigned(FMaskedBitmap) then + begin + FMaskedBitmap := TBitmap.Create; + FMaskedBitmap.Assign(Strip); + FMaskedBitmap.Width := FImageWidth; + if Strip.htTransparent then + begin + FMask := CreateBitmap(FImageWidth, FImageHeight); + FMask.Assign(Strip.htMask); + end; + FMaskedBitmap.Transparent := False; + end; +Result := FMaskedBitmap; +end; + +{----------------TGIFImage.GetMask:} +function TGIFImage.GetMask: TBitmap; +{This returns mask for frame 1. Content is black, background is white} +begin +if not FTransparent then + Result := nil +else + begin + if not Assigned(FMask) then + GetMaskedBitmap; + Result := FMask; + end; +end; + +{----------------TGIFImage.NextFrame} +procedure TGIFImage.NextFrame(OldFrame: Integer); +begin +WasDisposal := Frames[OldFrame].frDisposalMethod; +end; + +{----------------TgfFrameList.GetFrame} +function TgfFrameList.GetFrame(I: integer): TgfFrame; +begin +Assert((I <= Count) and (I >= 1 ), 'Frame index out of range'); +Result := TgfFrame(Items[I-1]); +end; + +{ ThtBitmap } +var + AHandle: THandle; + +destructor ThtBitmap.Destroy; +begin +htMask.Free; +inherited; +end; + +{----------------ThtBitmap.Draw} +procedure ThtBitmap.Draw(ACanvas: TCanvas; const Rect: TRect); +var + OldPalette: HPalette; + RestorePalette: Boolean; + DoHalftone: Boolean; + Pt: TPoint; + BPP: Integer; + MaskDC: HDC; + Save: THandle; +begin + with Rect do + begin + AHandle := ACanvas.Handle; {LDB} + PaletteNeeded; + OldPalette := 0; + RestorePalette := False; + + if Palette <> 0 then + begin + OldPalette := SelectPalette(ACanvas.Handle, Palette, True); + RealizePalette(ACanvas.Handle); + RestorePalette := True; + end; + BPP := GetDeviceCaps(ACanvas.Handle, BITSPIXEL) * + GetDeviceCaps(ACanvas.Handle, PLANES); + DoHalftone := (BPP <= 8) and (PixelFormat in [pf15bit, pf16bit, pf24bit]); + if DoHalftone then + begin + GetBrushOrgEx(ACanvas.Handle, pt); + SetStretchBltMode(ACanvas.Handle, HALFTONE); + SetBrushOrgEx(ACanvas.Handle, pt.x, pt.y, @pt); + end else if not Monochrome then + SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS); + try + AHandle := Canvas.Handle; {LDB} + if htTransparent then + begin + Save := 0; + MaskDC := 0; + try + MaskDC := CreateCompatibleDC(0); {LDB} + Save := SelectObject(MaskDC, MaskHandle); + TransparentStretchBlt(ACanvas.Handle, Left, Top, Right - Left, + Bottom - Top, Canvas.Handle, 0, 0, Width, + Height, htMask.Canvas.Handle, 0, 0); {LDB} + finally + if Save <> 0 then SelectObject(MaskDC, Save); + if MaskDC <> 0 then DeleteDC(MaskDC); + end; + end + else + StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, + Canvas.Handle, 0, 0, Width, + Height, ACanvas.CopyMode); + finally + if RestorePalette then + SelectPalette(ACanvas.Handle, OldPalette, True); + end; + end; +end; + +procedure ThtBitmap.StretchDraw(ACanvas: TCanvas; const DestRect, SrcRect: TRect); +{Draw parts of this bitmap on ACanvas} +var + OldPalette: HPalette; + RestorePalette: Boolean; + DoHalftone: Boolean; + Pt: TPoint; + BPP: Integer; +begin + with DestRect do + begin + AHandle := ACanvas.Handle; {LDB} + PaletteNeeded; + OldPalette := 0; + RestorePalette := False; + + if Palette <> 0 then + begin + OldPalette := SelectPalette(ACanvas.Handle, Palette, True); + RealizePalette(ACanvas.Handle); + RestorePalette := True; + end; + BPP := GetDeviceCaps(ACanvas.Handle, BITSPIXEL) * + GetDeviceCaps(ACanvas.Handle, PLANES); + DoHalftone := (BPP <= 8) and (PixelFormat in [pf15bit, pf16bit, pf24bit]); + if DoHalftone then + begin + GetBrushOrgEx(ACanvas.Handle, pt); + SetStretchBltMode(ACanvas.Handle, HALFTONE); + SetBrushOrgEx(ACanvas.Handle, pt.x, pt.y, @pt); + end else if not Monochrome then + SetStretchBltMode(ACanvas.Handle, STRETCH_DELETESCANS); + try + AHandle := Canvas.Handle; {LDB} + if htTransparent then + TransparentStretchBlt(ACanvas.Handle, Left, Top, Right - Left, + Bottom - Top, Canvas.Handle, + SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, + htMask.Canvas.Handle, SrcRect.Left, SrcRect.Top) {LDB} + else + StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, + Canvas.Handle, + SrcRect.Left, SrcRect.Top, SrcRect.Right - SrcRect.Left, SrcRect.Bottom - SrcRect.Top, + ACanvas.CopyMode); + finally + if RestorePalette then + SelectPalette(ACanvas.Handle, OldPalette, True); + end; + end; +end; + +{$else} + +{Dummy routines for NoGif option} + +interface + +uses +{$IFDEF HL_LAZARUS} + Classes, SysUtils, Graphics, Controls, ExtCtrls; +{$ELSE} + Windows, SysUtils, Classes, Graphics, Controls, ExtCtrls; +{$ENDIF} + +type + TGIFImage = class(TPersistent) + private + { Private declarations } + FCurrentFrame: Integer; + FImageWidth: Integer; + FImageHeight: Integer; + FNumFrames: Integer; + FTransparent: Boolean; + FVisible: Boolean; + FBitmap: TBitmap; + FAnimate: Boolean; + FMaskedBitmap: TBitmap; + FMask: TBitmap; + + public + ShowIt: boolean; + IsCopy: boolean; {set if this is a copy of one in Cache} + + { Public declarations } + constructor CreateCopy(Item: TGIFImage); + procedure Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer); + property Bitmap: TBitmap read FBitmap; + property MaskedBitmap: TBitmap read FMaskedBitmap; + property Mask: TBitmap read FMask; + property IsTransparent: Boolean read FTransparent; + property NumFrames: Integer read FNumFrames; + + procedure CheckTime(WinControl: TWinControl); + + property Width: integer read FImageWidth; + property Height: integer read FImageHeight; + property Animate: Boolean read FAnimate write FAnimate; + property CurrentFrame: Integer read FCurrentFrame write FCurrentFrame; + property Visible: Boolean read FVisible write FVisible; + end; + +function CreateAGifFromStream(var NonAnimated: boolean; + Stream: TStream): TGifImage; +function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage; + +implementation + +function CreateAGifFromStream(var NonAnimated: boolean; + Stream: TStream): TGifImage; +begin +Result := Nil; +end; + +function CreateAGif(const Name: string; var NonAnimated: boolean): TGifImage; +begin +Result := Nil; +end; + +constructor TGIFImage.CreateCopy(Item: TGIFImage); +begin +inherited Create; +end; + +{----------------TGIFImage.Draw} +procedure TGIFImage.Draw(Canvas: TCanvas; MasterList, Cell: TObject; X, Y, Wid, Ht: integer); +begin +end; + +{----------------TGifImage.CheckTime} +procedure TGifImage.CheckTime(WinControl: TWinControl); +begin +end; + +{$endif} + +end. + + diff --git a/components/htmllite/litepars.pas b/components/htmllite/litepars.pas new file mode 100644 index 0000000000..2b1672c488 --- /dev/null +++ b/components/htmllite/litepars.pas @@ -0,0 +1,2573 @@ +{Version 7.5} +{*********************************************************} +{* LITEPARS.PAS *} +{* Copyright (c) 1995-2002 by *} +{* L. David Baldwin *} +{* All rights reserved. *} +{*********************************************************} + +{$i LiteCons.inc} + +{ The Parser +This module contains the parser which reads thru the document. It divides it +into sections storing the pertinent information in Section objects. The +document itself is then a TList of section objects. See the LiteSubs unit for +the definition of the section objects. + +Key Variables: + + Sy: + An enumerated type which indicates what the current token is. For + example, a value of TextSy would indicate a hunk of text, PSy that a

+ tag was encountered, etc. + LCh: + The next character in the stream to be analyzed. In mixed case. + Ch: + The same character in upper case. + LCToken: + A string which is associated with the current token. If Sy is TextSy, + then LCToken contains the text. + Attributes: + A list of TAttribute's for tokens such as , , which have + attributes. + Section: + The current section being built. + SectionList: + The list of sections which form the document. When in a Table, + SectionList will contain the list that makes up the current cell. + +Key Routines: + + GetCh: + Gets the next character from the stream. Fills Ch and LCh. Skips + comments. + Next: + Gets the next token. Fills Sy, LCToken, Attributes. Calls GetCh so the + next character after the present token is available. Each part of the + parser is responsible for calling Next after it does its thing. +} + +unit LitePars; + +interface +uses + {$IFDEF HL_LAZARUS} + Classes, SysUtils, LCLType, Messages, GraphType, Graphics, Controls, + Dialogs, StdCtrls, LiteUn2, LiteSubs, LiteSbs1; + {$ELSE} + SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, + Dialogs, StdCtrls, LiteUn2, LiteSubs, LiteSbs1; + {$ENDIF} + +const + MaxStack = 25; + FontConv: array[1..7] of integer = (8,10,12,14,18,24,36); + PreFontConv: array[1..7] of integer = (7,8,10,12,15,20,30); + +type + LoadStyleType = (lsPrimary, lsInclude); + TIncludeType = procedure(Sender: TObject; const Command: string; + Params: TStrings; var IString: string) of Object; + TSoundType = procedure(Sender: TObject; const SRC: string; Loop: integer; + Terminate: boolean) of Object; + TMetaType = procedure(Sender: TObject; const HttpEq, Name, Content: string) of Object; + + SymbSet = Set of Symb; + + TLastChar = (lcOther, lcCR, lcLF); + + ThlParser = Class + private + Sy : Symb; + PreFormat: boolean; {set when doing preformat 

 text}
+    Justify: JustifyType;
+    BaseFontSize: integer;
+    InScript: boolean;     {when in a ') = 0 then    
+      Sy := ScriptEndSy;
+    end;
+
+  begin  {already have fresh character loaded here}
+  LCToken.Clear;    
+  if LCh = EofChar then Sy := EofSy
+  else if LCh = ^M then
+    begin
+    Sy := EolSy;
+    GetCh;
+    end
+  else if LCh = '<' then
+     GetTag1
+  else
+    begin
+    Sy := TextSy;
+    while (Length(LCToken.S) < 100) and  not (LCh in [^M, '<', EofChar]) do 
+      begin
+      LCToken.AddChar(LCh, SIndex);  
+      GetCh;
+      end;
+    end;
+  end;
+
+begin
+try
+  if Assigned(AScript) then
+    begin
+    InScript := True;
+    if Attributes.Find(LanguageSy, T) then
+      Lang := T.Name
+    else Lang := '';
+    if Attributes.Find(NameSy, T) then 
+      AName := T.Name
+    else AName := '';                  
+
+    GetMem(Buffer, Block);
+    Pos := 0;
+    Size := Block;
+    try
+      Next1;
+      while (Sy <> ScriptEndSy) and (Sy <> EofSy) do
+        begin
+        if Sy = EolSy then AddText(^M^J)
+        else
+          AddText(LCToken.S);  
+        Next1;
+        end;
+      AddText(#0);
+      ReAllocMem(Buffer, Size);
+      AScript(CallingObject, AName, Lang, Buffer);
+    except
+      FreeMem(Buffer);
+      Raise;
+      end;
+    end
+  else
+    begin
+    repeat
+      Next1;
+    until Sy in [ScriptEndSy, EofSy];
+    end;
+finally
+  InScript := False;
+  end;
+end;
+
+{----------------DoCommonSy}
+procedure ThlParser.DoCommonSy(Lev: integer);
+var
+  I: integer;
+  TxtArea: TTextAreaFormControlObj;
+  FormControl: TFormControlObj;
+  T: TAttribute;
+  TmpJustify, LastAlign: JustifyType;
+  Tmp: string;
+
+  function IncrementFont(Sy: Symb; Pre: boolean): boolean;
+  var
+    NewSize: integer;
+
+    function GetSizeIndex(Pre: boolean; Size: integer): integer;
+    begin
+    for Result := 1 to 7 do
+      if Pre and (Size = PreFontConv[Result]) then Exit
+      else if Size = FontConv[Result] then Exit;
+    Result := -1;
+    end;
+
+  begin
+  Result := False;
+  NewSize := GetSizeIndex(Pre, FontStack[StackIndex].NormalSize);
+  if (Sy = BigSy) then
+    begin
+    if (NewSize in [1..6]) then Inc(NewSize);
+    end
+  else
+    if NewSize in [2..7] then Dec(NewSize);   
+
+  if PushNewFont then
+    begin
+    if Pre then NewSize := PreFontConv[NewSize]
+    else NewSize := FontConv[NewSize];
+    FontStack[StackIndex].SetNormalSize(MasterList, NewSize);
+    Result := True;
+    end;
+  end;
+
+  function ChangeTheFont(Sy: Symb; Pre: boolean): boolean;
+  var
+    FaceName: string[50];
+    NewColor: TColor;
+    NewSize, I, K: integer;
+    FontResults: set of (Face, Colr, Siz);
+  begin
+  FontResults := [];
+  NewSize := 0;  {get rid of warning}
+  for I := 0 to Attributes.Count-1 do
+    with TAttribute(Attributes[I]) do
+      case Which of
+        SizeSy:
+          begin
+          if (Length(Name) >= 2) and (Name[1] in ['+', '-']) then
+            Value := BaseFontSize + Value;
+          NewSize := IntMax(1, IntMin(7, Value)); {limit 1..7}
+          if (Sy = BaseFontSy) then BaseFontSize := NewSize;
+          Include(FontResults, Siz);
+          end;
+        ColorSy:
+          if (Sy <> BaseFontSy) and GetColor(Name, NewColor) then Include(FontResults, Colr);
+        FaceSy:
+          if (Sy <> BaseFontSy) and (Name <> '') then
+            begin
+            FaceName := Name;
+            K := Pos(',', FaceName);
+            if K > 0 then
+              Delete(FaceName, K, 255);
+            FaceName := Trim(FaceName);
+            if FaceName <> '' then
+              Include(FontResults, Face);
+            end;
+        end;
+  Result := False;
+  if ((Sy <> BasefontSy) or (SectionList.Count = 0) and
+          (SectionList = MasterList)) and  {new font only if at start for Basefont}
+       PushNewFont and (FontResults <> []) then
+    with FontStack[StackIndex] do
+      begin
+      if Colr in FontResults then
+        Color := NewColor or $2000000;
+      if Siz in FontResults then
+        begin
+        if Pre then NewSize := PreFontConv[NewSize]
+        else NewSize := FontConv[NewSize];
+        SetNormalSize(MasterList, NewSize);
+        end;
+      if Face in FontResults then
+        Name := FaceName;
+      Result := True;
+      end;
+  end;
+
+  procedure DoPreSy;
+  var
+    S: TokenObj;    
+    Tmp: String;
+    Done: boolean;
+    I, InitialStackIndex: integer;
+
+    procedure NewSection;
+    begin
+    Section.AddTokenObj(S, NoBreak);
+    S.Clear; 
+    SectionList.Add(Section);
+    Section := TPreFormated.Create(MasterList, Lev, FontStack[StackIndex],
+               CurrentUrlTarget, Left);
+    end;
+
+  begin
+  S := TokenObj.Create;   
+  try
+    SectionList.Add(Section);
+    PushNewFont;
+    InitialStackIndex := StackIndex;   
+    with FontStack[StackIndex] do
+      begin
+      Name := MasterList.PreFontName;
+      SetNormalSize(MasterList, 10);
+      Fixed := True;
+      end;
+    Section := TPreformated.Create(MasterList, Lev, FontStack[StackIndex],
+               CurrentUrlTarget, Left);
+    S.Clear;  
+    PreFormat := True;
+    Done := False;
+    while not Done do
+      case Ch of
+        '&': begin
+             Next;
+             S.Concat(LCToken);  
+             end;
+        '<':
+           begin
+           Next;
+           case Sy of
+             PSy, BRSy:
+               begin
+               NewSection;
+               if Ch = ^M then GetCh;
+               end;
+
+             PreEndSy, TDEndSy, THEndSy:
+               Done := True;
+
+             BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
+                 USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
+                 SSy, SEndSy, StrikeSy, StrikeEndSy:
+               begin
+               Section.AddTokenObj(S, NoBreak);
+               S.Clear;   
+               case Sy of
+                 BSy, StrongSy:  CurrentStyle := CurrentStyle + [fsBold];
+                 BEndSy, StrongEndSy:  CurrentStyle := CurrentStyle - [fsBold];
+                 ISy, EmSy, CiteSy, VarSy:  CurrentStyle := CurrentStyle + [fsItalic];
+                 IEndSy, EmEndSy,
+                   CiteEndSy, VarEndSy:  CurrentStyle := CurrentStyle - [fsItalic];
+                 USy:  CurrentStyle := CurrentStyle + [fsUnderline];
+                 UEndSy:  CurrentStyle := CurrentStyle - [fsUnderline];
+                 SSy, StrikeSy:  CurrentStyle := CurrentStyle + [fsStrikeOut];
+                 SEndSy, StrikeEndSy:  CurrentStyle := CurrentStyle - [fsStrikeOut];
+                 end;
+
+               TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+               end;
+
+             FontSy, BaseFontSy:
+               begin
+               Section.AddTokenObj(S, NoBreak);
+               S.Clear;
+               if ChangeTheFont(Sy, True) then
+                 TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+               end;
+             FontEndSy:
+               if StackIndex > InitialStackIndex then  
+                 begin
+                 PopFont;
+                 Section.AddTokenObj(S, NoBreak);
+                 S.Clear;
+                 TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+                 end;
+             ASy:
+               for I := 0 to Attributes.Count-1 do
+                 with TAttribute(Attributes[I]) do
+                   case Which of
+                     NameSy:
+                       if Name <> '' then
+                         begin
+                         Tmp := UpperCase(Name);
+                         {Author may have added '#' by mistake}
+                         if (Length(Tmp) > 0) and (Tmp[1] = '#') then
+                           Delete(Tmp, 1, 1);
+                         NameList.AddObject(Tmp, Section);
+                         end;
+                     HRefSy:
+                       begin
+                       Section.AddTokenObj(S, NoBreak);
+                       S.Clear;
+                       if InHref then DoAEnd;
+                       if Name <> '' then  {also have a string}
+                         begin
+                         if Attributes.Find(TargetSy, T) then
+                           CurrentUrlTarget.Assign(Name, T.Name)
+                         else CurrentUrlTarget.Assign(Name, '');
+                         InHref := True;
+                         PushNewFont;
+                         with FontStack[StackIndex] do
+                           begin
+                           Style := Style + MasterList.UnLine;
+                           Color := MasterList.HotSpotColor;
+                           end;
+                         end;
+                       Section.HRef(HRefSy, MasterList, CurrentUrlTarget, FontStack[StackIndex]);
+                       end;
+                     end;
+             AEndSy:
+               begin
+               Section.AddTokenObj(S, NoBreak);
+               S.Clear;
+               DoAEnd;
+               end;
+             ImageSy:
+               begin
+               Section.AddTokenObj(S, NoBreak);
+               TSection(Section).AddImage(Attributes, SectionList, TagIndex, NoBreak);
+               S.Clear;
+               end;
+             InputSy, SelectSy:
+               begin
+               Section.AddTokenObj(S, NoBreak);
+               FormControl := TSection(Section).AddFormControl(Sy, MasterList,
+                           Attributes, SectionList, TagIndex, NoBreak);
+               if Sy = SelectSy then
+                 GetOptions(FormControl as TListBoxFormControlObj);
+               S.Clear;;
+               end;
+             TextAreaSy:
+               Begin
+               Section.AddTokenObj(S, NoBreak);
+               TxtArea := TSection(Section).AddFormControl(TextAreaSy, MasterList,
+                          Attributes, SectionList, TagIndex, NoBreak) as TTextAreaFormControlObj;
+               DoTextArea(TxtArea);
+               S.Clear;
+               end;
+             FormSy:
+               CurrentForm := ThtmlForm.Create(MasterList, Attributes);
+             FormEndSy:
+               CurrentForm := Nil;
+             MapSy: DoMap;
+             ScriptSy: DoScript(MasterList.ScriptEvent);
+             end;
+           end;
+        ^M : begin NewSection; GetCh; end;
+        EofChar : Done := True;
+        else
+          begin   {all other chars}
+          S.AddChar(LCh, SIndex);  
+          if Length(S.S) > 200 then
+            begin
+            Section.AddTokenObj(S, NoBreak);
+            S.Clear;
+            end;
+          GetCh;
+          end;
+        end;
+    Section.AddTokenObj(S, NoBreak);
+    SectionList.Add(Section);
+    Section := Nil;
+    PreFormat := False;
+    while StackIndex >= InitialStackIndex do   
+      PopFont;
+    Next;
+  finally
+    S.Free;   
+    end;
+  end;
+
+  function CreateFont(HeadNmb: integer; OldFont: TMyFont): TMyFont;
+  var
+    F : TMyFont;
+    Siz: integer;
+  begin
+  F := TMyFont.Create;
+  F.Assign(OldFont);
+  case HeadNmb of
+    0: Siz := 12;     {0 is no heading}
+    1: Siz := 24;
+    2: Siz := 18; 
+    3: Siz := 14;  
+    4: Siz := 12;
+    5: Siz := 10;
+    6: Siz := 8;
+    else Siz := 12;
+  end;
+  if HeadNmb > 0 then
+    F.Style := F.Style + [fsBold];
+  F.SetNormalSize(MasterList, Siz);
+  Result := F;
+  end;
+
+begin
+case Sy of
+  TextSy :
+    begin
+    if not Assigned(Section) then
+      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+                 CurrentUrlTarget, Justify);
+    Section.AddTokenObj(LCToken, NoBreak);
+    Next;
+    end;
+  ImageSy:
+    begin
+    if not Assigned(Section) then
+      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+                 CurrentUrlTarget, Justify);
+    TSection(Section).AddImage(Attributes, SectionList, TagIndex, NoBreak);
+    Next;
+    end;
+  InputSy, SelectSy:
+    begin
+    if not Assigned(Section) then
+      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+                 CurrentUrlTarget, Justify);
+    FormControl := TSection(Section).AddFormControl(Sy, MasterList, Attributes, SectionList, TagIndex, NoBreak);
+    if Sy = SelectSy then
+      GetOptions(FormControl as TListBoxFormControlObj);
+    Next;
+    end;
+  TextAreaSy:
+    Begin
+    if not Assigned(Section) then
+      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+                 CurrentUrlTarget, Justify);
+    TxtArea := TSection(Section).AddFormControl(TextAreaSy, MasterList,
+               Attributes, SectionList, TagIndex, NoBreak) as TTextAreaFormControlObj; 
+    DoTextArea(TxtArea);
+    Next;
+    end;
+  TextAreaEndSy:   {a syntax error but shouldn't hang}
+    Next;
+  FormSy:
+    begin
+    CurrentForm := ThtmlForm.Create(MasterList, Attributes);
+    Next;
+    end;
+  FormEndSy:
+    begin
+    CurrentForm := Nil;
+    Next;
+    end;
+  PSy, PEndSy:
+    begin
+    SectionList.Add(Section);
+    Section := Nil;
+    if Not NoPSpace then
+      SectionList.Add(TParagraphSpace.Create(MasterList));
+    SkipWhiteSpace;
+    LastAlign := FindAlignment;
+    NoPSpace := True;
+    Next;
+    while Sy in [PSy, PEndSy] do
+      begin           {recognize only the first 
}
+      LastAlign := FindAlignment;   {if a series of 
, get last alignment}
+      SkipWhiteSpace;
+      NoPSpace := True;
+      Next;
+      end;
+    Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+               CurrentUrlTarget, LastAlign);
+    end;
+  BRSy:
+    begin
+    if Assigned(Section) then
+      TmpJustify := TSection(Section).BreakInfo(TagIndex, NoBreak)  {so 
 doesn't change justification}
+    else TmpJustify := Justify;
+    SectionList.Add(Section);
+    Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+               CurrentUrlTarget, TmpJustify);
+    Section.DoClearAttribute(Attributes);     {check for clear attribute}
+    Next;
+    end;
+  NoBrSy, NoBrEndSy:
+    begin
+    NoBreak := Sy = NoBrSy;
+    if Assigned(Section) then
+      Section.AddTokenObj(LCToken, NoBreak);
+    Next;
+    end;
+  WbrSy:
+    begin
+    if Assigned(Section) and NoBreak then
+      Section.AddChar(' ', TagIndex, NoBreak);
+    Next;
+    end;
+  BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
+      USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
+      SubSy, SubEndSy, SupSy, SupEndSy, SSy, SEndSy, StrikeSy, StrikeEndSy:
+    begin
+    case Sy of
+      BSy, StrongSy:  CurrentStyle := CurrentStyle + [fsBold];
+      BEndSy, StrongEndSy:  CurrentStyle := CurrentStyle - [fsBold];
+      ISy, EmSy, CiteSy, VarSy:  CurrentStyle := CurrentStyle + [fsItalic];
+      IEndSy, EmEndSy,
+        CiteEndSy, VarEndSy:  CurrentStyle := CurrentStyle - [fsItalic];
+      USy:  CurrentStyle := CurrentStyle + [fsUnderline];
+      UEndSy:  CurrentStyle := CurrentStyle - [fsUnderline];
+      SSy, StrikeSy:  CurrentStyle := CurrentStyle + [fsStrikeOut];
+      SEndSy, StrikeEndSy:  CurrentStyle := CurrentStyle - [fsStrikeOut];
+      SubEndSy, SupEndSy: CurrentSScript := Normal;
+      SubSy, SupSy:
+        begin
+        if not Assigned(Section) then
+          Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+                     CurrentUrlTarget, Justify);
+        if Sy = SubSy then CurrentSScript := SubSc
+          else CurrentSScript := SupSc;
+        end;
+      end;
+
+    if Assigned(Section) then    {CurrentStyle used in ChangeFont}
+      TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+    Next;
+    end;
+  TTSy, CodeSy, KbdSy, SampSy:
+    begin
+    if PushNewFont then
+      begin
+      with FontStack[StackIndex] do
+        begin
+        Name := MasterList.PreFontName;
+        SetNormalSize(MasterList, 10);
+        Fixed := True;
+        end;
+      if Assigned(Section) then
+        TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+      end;
+    Next;
+    end;
+  TTEndSy, CodeEndSy, KbdEndSy, SampEndSy, FontEndSy, BigEndSy, SmallEndSy:
+    begin
+    PopFont;
+      if Assigned(Section) then
+        TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+    Next;
+    end;
+  FontSy, BaseFontSy:
+    begin
+    if ChangeTheFont(Sy, False) and Assigned(Section) then
+      TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+    Next;
+    end;
+  BigSy, SmallSy:
+    begin
+    if IncrementFont(Sy, False) and Assigned(Section) then
+      TSection(Section).ChangeFont(MasterList, FontStack[StackIndex]);
+    Next;
+    end;
+  AddressSy:
+    begin
+    SectionList.Add(Section);
+    PushNewFont;
+    with FontStack[StackIndex] do
+      Style := Style + [fsItalic];
+    Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+               CurrentUrlTarget, Justify);
+    Next;
+    end;
+  AddressEndSy:
+    begin
+    SectionList.Add(Section);
+    Section := Nil;
+    PopFont;
+    Next;
+    end;
+  ASy:
+    begin
+    for I := 0 to Attributes.Count-1 do
+      with TAttribute(Attributes[I]) do
+        case Which of
+          NameSy:
+            if Name <> '' then
+              begin
+              if not Assigned(Section) then
+                Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+                           CurrentUrlTarget, Justify);
+              Tmp := UpperCase(Name);
+              {Author may have added '#' by mistake}
+              if (Length(Tmp) > 0) and (Tmp[1] = '#') then
+                Delete(Tmp, 1, 1);
+              NameList.AddObject(Tmp, Section);
+              end;
+          HRefSy:
+            begin
+            if InHref then DoAEnd;
+            if Name <> '' then  {also have a string}
+              begin
+              if Attributes.Find(TargetSy, T) then
+                CurrentUrlTarget.Assign(Name, T.Name)
+              else CurrentUrlTarget.Assign(Name, '');
+              InHref := True;
+              PushNewFont;
+              with FontStack[StackIndex] do
+                begin
+                Style := Style + MasterList.UnLine;
+                Color := MasterList.HotSpotColor;
+                end;
+              if Assigned(Section) then
+                Section.HRef(HRefSy, MasterList, CurrentUrlTarget, FontStack[StackIndex]);
+              end;
+            end;
+          end;
+    Next;
+    end;
+  AEndSy:
+    begin
+    DoAEnd;
+    Next;
+    end;
+  HeadingSy:
+    begin
+    if StackIndex < MaxStack then
+      begin
+      SectionList.Add(Section);
+      Inc(StackIndex);
+      FontStack[StackIndex] := CreateFont(Value, FontStack[StackIndex-1]);
+      SectionList.Add(THeadingSpace.Create(MasterList, Value));
+      Section := TSection.Create(MasterList, Lev, FontStack[StackIndex],
+                 CurrentUrlTarget, FindAlignment);
+      end;
+    Next;
+    end;
+  HeadingEndSy:
+    begin
+    if StackIndex > 1 then
+      begin
+      SectionList.Add(Section);
+      SectionList.Add(THeadingSpace.Create(MasterList, Value));
+      Section := Nil;
+      PopFont;
+      end;
+    Next;
+    end;
+  PreSy:  DoPreSy;
+  TableSy: DoTable(Lev);
+  MapSy: DoMap;
+  ScriptSy: begin DoScript(MasterList.ScriptEvent); Next; end;
+  end;
+end;   {DoCommon}
+
+{-------------DoLists}
+procedure ThlParser.DoLists(Level: integer; Sym: Symb; const TermSet: SymbSet);
+var
+  LineCount, CurrentLevel: integer;
+  T: TAttribute;
+  Plain: boolean;
+  Index: char;   
+
+begin
+LineCount := 1;
+Index := '1';
+Plain := False;
+if (Sym = OLSy) then
+  begin
+  if Attributes.Find(StartSy, T) then
+    if T.Value >= 0 then LineCount := T.Value;
+  if Attributes.Find(TypeSy, T) and (T.Name <> '') then
+    Index := T.Name[1];
+  end
+else Plain := (Sym = ULSy) and Attributes.Find(PlainSy, T);
+CurrentLevel := Level;
+SectionList.Add(Section);
+Section := Nil;
+Next;
+if Sy in [OLEndSy, ULEndSy, DirEndSy, MenuEndSy, DLEndSy, BlockQuoteEndSy] then
+  Exit;    {guard against 
     and similar combinations}
+repeat
+  case Sy of
+    LISy:
+      begin
+      SectionList.Add(Section);
+      if Sym = OLSy then
+        begin
+        Section := TOListItem.Create(MasterList, Level, LineCount, Index,
+                    FontStack[StackIndex], CurrentUrlTarget);
+        Inc(LineCount);
+        end
+      else Section := TUlistItem.Create(MasterList, Level, FontStack[StackIndex],
+                      CurrentUrlTarget);
+      if (Sym = ULSy) and Plain then
+        TUlistItem(Section).Plain := True;
+      CurrentLevel := Level;
+      SkipWhiteSpace;
+      Next;
+      if Sy = PSy then Next;
+      end;
+    DTSy, DDSy:
+      begin
+      SectionList.Add(Section);
+      if Sy = DTSy then
+        CurrentLevel := Level-1
+      else CurrentLevel := Level;
+      Section := TDListItem.Create(MasterList, CurrentLevel, FontStack[StackIndex],
+                 CurrentUrlTarget);
+      Next;
+      end;
+    OLSy, ULSy, DirSy, MenuSy, DLSy:
+      begin
+      DoLists(Level+1, Sy, TermSet);
+      Next;
+      end;
+    BlockQuoteSy:
+      begin
+      SectionList.Add(Section);
+      Section := Nil;
+      DoLists(Level+1, Sy, TermSet);
+      Next;
+      end;
+    DivSy, CenterSy:
+      DoBody(CurrentLevel, [OLEndSy, ULEndSy, DirEndSy, MenuEndSy, DLEndSy,
+             BlockQuoteEndSy, EofSy]+TermSet);
+    HRSy:
+      begin
+      SectionList.Add(Section);
+      SectionList.Add(THorzLine.Create(MasterList, Attributes));
+      Section := Nil;
+      Next;
+      end;
+  TableSy:
+      begin
+      if Assigned(Section) then
+        TSection(Section).BreakInfo(TagIndex, NoBreak);
+      DoTable(CurrentLevel);   
+      end;
+
+    TextSy, BRSy, PSy, PEndSy,
+    BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
+        USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
+        SubSy, SubEndSy, SupSy, SupEndSy, SSy, SEndSy, StrikeSy, StrikeEndSy, 
+    TTSy, CodeSy, KbdSy, SampSy,  TTEndSy, CodeEndSy, KbdEndSy, SampEndSy,
+    NameSy, HRefSy, ASy, AEndSy,
+    HeadingSy, HeadingEndSy, AddressSy, AddressEndSy, PreSy,
+    InputSy, FormSy, FormEndSy, TextAreaSy, TextAreaEndSy, SelectSy,
+    ImageSy, FontSy, FontEndSy, BaseFontSy, BigSy, BigEndSy, SmallSy,
+    SmallEndSy, MapSy, ScriptSy, NoBrSy, NoBrEndSy, WbrSy:
+      DoCommonSy(CurrentLevel);
+    else if Sy in TermSet then Exit
+      else Next;
+    end;
+Until (Sy in [OLEndSy, ULEndSy, DirEndSy, MenuEndSy, DLEndSy,
+             BlockQuoteEndSy, EofSy]);
+SectionList.Add(Section);
+Section := Nil;
+end;
+
+{----------------DoBase}
+procedure ThlParser.DoBase;
+var
+  I: integer;
+begin
+with Attributes do
+  for I := 0 to Count-1 do
+    with TAttribute(Attributes[I]) do
+      if Which = HrefSy then
+        Base := Name
+      else if Which = TargetSy then
+        BaseTarget := Name;
+Next;
+end;
+
+procedure ThlParser.DoSoundEvent;
+begin
+SoundEvent(CallingObject, ATName, ALoop, False);
+end;
+
+{----------------DoSound}
+procedure ThlParser.DoSound;
+var
+  T, T1: TAttribute;
+begin
+if Assigned(SoundEvent) and Attributes.Find(SrcSy, T) then
+  begin
+  if Attributes.Find(LoopSy, T1) then ALoop := T1.Value
+    else ALoop := 1;
+  ATName := T.Name;
+  TParseThread(ParseThread).Synchronize(
+    {$IFDEF HL_LAZARUS}@{$ENDIF}DoSoundEvent);
+  end;
+Next;
+end;
+
+function ThlParser.TranslateCharset(DefCharset: TFontCharset;
+  const {$IFDEF HL_LAZARUS}NewContent{$ELSE}Content{$ENDIF}: string): TFontCharset;
+type
+  XRec = record S: string; CSet: TFontCharset; end;
+const
+  MaxX = 14;
+  XTable: array[1..MaxX] of XRec =
+     ((S:'1252';    CSet:ANSI_CHARSET),
+      (S:'8859-1';    CSet:ANSI_CHARSET),
+      (S:'1253';    CSet:GREEK_CHARSET),
+      (S:'8859-7';    CSet:GREEK_CHARSET),
+      (S:'1250';    CSet:EASTEUROPE_CHARSET),
+      (S:'8859-2';    CSet:EASTEUROPE_CHARSET),
+      (S:'1251';    CSet:RUSSIAN_CHARSET),
+      (S:'8859-5';    CSet:RUSSIAN_CHARSET),
+      (S:'koi8-r';    CSet:RUSSIAN_CHARSET),
+      (S:'1254';    CSet:TURKISH_CHARSET),
+      (S:'8859-3';    CSet:TURKISH_CHARSET),
+      (S:'8859-9';    CSet:TURKISH_CHARSET),
+      (S:'1257';    CSet:BALTIC_CHARSET),
+      (S:'8859-4';    CSet:BALTIC_CHARSET));
+var
+  I: integer;
+begin
+Result := DefCharset;
+for I := 1 to MaxX do
+  if Pos(XTable[I].S,
+    Lowercase({$IFDEF HL_LAZARUS}NewContent{$ELSE}Content{$ENDIF})) > 0
+  then
+    Begin
+    Result := XTable[I].CSet;
+    Break;
+    end;
+end;
+
+procedure ThlParser.DoMetaEvent;
+begin
+MetaEvent(CallingObject, HttpEq, ATName, Content);
+end;
+
+{----------------DoMeta}
+procedure ThlParser.DoMeta(Sender: TObject);
+var
+  T: TAttribute;
+  {$ifdef ver100_plus}
+  Charset: TFontCharset;
+  {$endif}
+begin
+if Attributes.Find(HttpEqSy, T) then HttpEq := T.Name
+  else HttpEq := '';
+if Attributes.Find(NameSy, T) then ATName := T.Name
+  else ATName := '';
+if Attributes.Find(ContentSy, T) then Content := T.Name
+  else Content := '';
+{$ifdef ver100_plus}
+if (Sender is ThtmlLite) and (CompareText(HttpEq, 'content-type') = 0) then  
+  begin
+  CharSet := TranslateCharset(TSectionList(SectionList).Charset, Content);
+  FontStack[StackIndex].Charset := Charset;
+  end;
+{$endif}
+if Assigned(MetaEvent) then
+  TParseThread(ParseThread).Synchronize({$IFDEF HL_LAZARUS}@{$ENDIF}DoMetaEvent);
+Next;
+end;
+
+{----------------DoTitle}
+procedure ThlParser.DoTitle;
+begin
+Title := '';
+Next;
+while Sy = TextSy do
+  begin
+  Title := Title+LCToken.S;
+  Next;
+  end;
+end;
+
+{-------------DoBody}
+procedure ThlParser.DoBody(Level: integer; const TermSet: SymbSet);
+var
+  I, SaveIndent: integer;  
+  Val: TColor;
+  T: TAttribute;
+  SaveJustify: JustifyType;
+  S: string[10];
+  SaveSy: Symb;
+
+begin
+repeat
+  case Sy of
+    TextSy, BRSy, PSy, PEndSy,
+    NameSy, HRefSy, ASy, AEndSy,
+    BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
+        USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
+        SubSy, SubEndSy, SupSy, SupEndSy,  SSy, SEndSy, StrikeSy, StrikeEndSy,
+    TTSy, CodeSy, KbdSy, SampSy,  TTEndSy, CodeEndSy, KbdEndSy, SampEndSy,
+    HeadingSy, HeadingEndSy, AddressSy, AddressEndSy, PreSy, TableSy,
+    InputSy, FormSy, FormEndSy, TextAreaSy, TextAreaEndSy, SelectSy,
+    ImageSy, FontSy, FontEndSy, BaseFontSy, BigSy, BigEndSy, SmallSy,
+    SmallEndSy, MapSy, ScriptSy, NoBrSy, NoBrEndSy, WbrSy:
+      DoCommonSy(Level);
+    BodySy:
+      begin
+      if SectionList.Count = 0 then   {make sure we're at beginning}
+        begin
+        Section.Free;   {Will start with a new section}
+        for I := 0 to Attributes.Count-1 do
+          with TAttribute(Attributes[I]) do
+            case Which of
+              BackgroundSy: MasterList.SetBackgroundBitmap(Name);
+              TextSy: if GetColor(Name, Val) then
+                begin
+                FontStack[StackIndex].Color := Val or $2000000;
+                MasterList.FontColor := Val or $2000000;
+                end;
+              BGColorSy: if GetColor(Name, Val) then MasterList.SetBackGround(Val or $2000000);
+              LinkSy: if GetColor(Name, Val) then MasterList.HotSpotColor := Val or $2000000;
+              VLinkSy: if GetColor(Name, Val) then MasterList.LinkVisitedColor := Val or $2000000;
+              OLinkSy: if GetColor(Name, Val) then
+                 begin
+                 MasterList.LinkActiveColor := Val or $2000000;
+                 MasterList.LinksActive := True;
+                 end;
+              MarginWidthSy:   
+                if CallingObject is ThtmlLite then
+                  ThtmlLite(CallingObject).FMarginWidthX := IntMin(IntMax(0,Value), 200);
+              MarginHeightSy:
+                if CallingObject is ThtmlLite then
+                  ThtmlLite(CallingObject).FMarginHeightX := IntMin(IntMax(0,Value), 200);
+            end;
+        Section := TSection.Create(MasterList, Level, FontStack[1], Nil, Justify);
+        end;
+      Next;
+      end;
+    HRSy:
+      begin
+      SectionList.Add(Section);
+      SectionList.Add(THorzLine.Create(MasterList, Attributes));
+      Section := Nil;
+      Next;
+      end;
+    OLSy, ULSy, DirSy, MenuSy, DLSy:
+      begin
+      DoLists(1, Sy, TermSet);
+      Next;
+      end;
+    LiSy:
+      if Level = 0 then
+        begin
+        SectionList.Add(Section);
+        SaveIndent := ListIndent;
+        ListIndent := SmallListIndent;
+        Section := TUlistItem.Create(MasterList, 1, FontStack[StackIndex],
+                      CurrentUrlTarget);
+        SkipWhiteSpace;
+        Next;
+        while Sy in [TextSy, NoBrSy, NoBrEndSy, WbrSy, BSy, ISy, BEndSy, IEndSy,
+                     EmSy, EmEndSy, StrongSy, StrongEndSy, USy, UEndSy, CiteSy,
+                     CiteEndSy, VarSy, VarEndSy, SubSy, SubEndSy, SupSy, SupEndSy,
+                     SSy, SEndSy, StrikeSy, StrikeEndSy, TTSy, CodeSy, KbdSy, SampSy,
+                     TTEndSy, CodeEndSy, KbdEndSy, SampEndSy, FontEndSy, BigEndSy,
+                     SmallEndSy, BigSy, SmallSy, ASy, AEndSy] do
+          begin
+          DoCommonSy(1);
+          end;
+        SectionList.Add(Section);
+        Section := Nil;
+        ListIndent := SaveIndent;
+        end
+      else Next;
+    BlockQuoteSy:
+      begin
+      SectionList.Add(Section);
+      Section := Nil;
+      DoLists(1, Sy, TermSet);
+      Next;
+      end;
+    DivSy, CenterSy:
+      begin
+      SaveSy := Sy;
+      SectionList.Add(Section);
+      SaveJustify := Justify;
+      if SaveSy = CenterSy then
+        Justify := Centered
+      else
+        if Attributes.Find(AlignSy, T) then
+          begin
+          S := LowerCase(T.Name);
+          if S = 'left' then Justify := Left
+          else if S = 'center' then Justify := Centered
+          else if S = 'right' then Justify := Right;
+          end;
+      Section := TSection.Create(MasterList, Level, FontStack[StackIndex],
+                 CurrentUrlTarget, Justify);
+      Next;
+      DoBody(Level, [CenterEndSy, DivEndSy]+TermSet);
+      SectionList.Add(Section);
+      Justify := SaveJustify;
+      Section := TSection.Create(MasterList, Level, FontStack[StackIndex],
+                 CurrentUrlTarget, Justify);
+      if Sy in [CenterEndSy, DivEndSy] then
+        Next;
+      end;
+    TitleSy:
+      DoTitle;
+    BgSoundSy:
+      DoSound;
+    MetaSy:
+      DoMeta(CallingObject);
+    BaseSy:
+      DoBase;
+    else if Sy in TermSet then Exit
+    else Next;
+    end;
+Until (Sy = EofSy);
+Next;
+end;
+
+procedure ThlParser.ParseInit(ASectionList: TList; ANameList: TStringList; AIncludeEvent: TIncludeType);
+begin
+SectionList := TSectionList(ASectionList);
+MasterList := TSectionList(SectionList);
+CallingObject := TSectionList(ASectionList).TheOwner;
+IncludeEvent := AIncludeEvent;
+NameList := ANameList;
+PreFormat := False;
+StackIndex := 1;
+FontStack[1] := TMyFont.Create;
+FontStack[1].Name := MasterList.FontName;
+FontStack[1].Color := MasterList.FontColor;
+FontStack[1].SetNormalSize(MasterList, 12);
+{$ifdef ver100_plus}
+FontStack[1].Charset := TSectionList(SectionList).Charset;
+{$endif}
+CurrentURLTarget := TUrlTarget.Create;
+InHref := False;
+BaseFontSize := 3;
+
+Title := '';
+Base := '';
+BaseTarget := '';
+Justify := Left;
+CurrentStyle := [];
+CurrentForm := Nil;
+Section := TSection.Create(MasterList, 0, FontStack[1], Nil, Justify);
+Attributes := TAttributeList.Create;
+SIndex := -1;
+InScript := False;
+NoPSpace := False;
+NoBreak := False;
+end;
+
+{----------------ThlParser.HtmlParseString}
+procedure ThlParser.HtmlParseString(ASectionList: TList; ANameList: TStringList;
+                   AIncludeEvent: TIncludeType; ASoundEvent: TSoundType;
+                   AMetaEvent: TMetaType);
+begin
+LoadStyle := lsPrimary;
+ParseInit(ASectionList, ANameList, AIncludeEvent);
+SoundEvent := ASoundEvent;
+MetaEvent := AMetaEvent;
+Buffer := TParseThread(ParseThread).Buffer;
+BuffEnd := TParseThread(ParseThread).BuffEnd;
+try
+  try
+    GetCh; {get the reading started}
+    Next;
+    DoBody(0, []);
+  except
+    On EParseError do;   {ignore this error}
+  end;
+finally
+  Attributes.Free;
+  if Assigned(Section) then
+    SectionList.Add(Section);
+  while StackIndex >= 1 do
+    begin
+    FontStack[StackIndex].Free;
+    Dec(StackIndex);
+    end;
+  CurrentURLTarget.Free;
+  end;
+end;
+
+{----------------DoText}
+procedure ThlParser.DoText;        
+var
+  S: TokenObj;
+  Done: boolean;
+
+  procedure NewSection;
+  begin
+  Section.AddTokenObj(S, NoBreak);
+  S.Clear;
+  SectionList.Add(Section);
+  Section := TPreFormated.Create(MasterList, 0, FontStack[StackIndex], CurrentURLTarget, Left);
+  end;
+
+begin
+S := TokenObj.Create;
+try
+  SectionList.Add(Section);
+  PushNewFont;
+  with FontStack[StackIndex] do
+    begin
+    Name := MasterList.PreFontName;
+    SetNormalSize(MasterList, 10);
+    Fixed := True;
+    end;
+  Section := TPreformated.Create(MasterList, 0, FontStack[StackIndex],
+             CurrentURLTarget, Left);
+  PreFormat := True;
+  Done := False;
+  while not Done do
+    case Ch of
+      ^M : begin NewSection; GetCh; end;
+      EofChar : Done := True;
+      else
+        begin   {all other chars}
+        S.AddChar(LCh, SIndex);
+        if Length(S.S) > 200 then
+          begin
+          Section.AddTokenObj(S, NoBreak);
+          S.Clear;
+          end;
+        GetCh;
+        end;
+      end;
+  Section.AddTokenObj(S, NoBreak);
+  SectionList.Add(Section);
+  Section := Nil;
+  PreFormat := False;
+  PopFont;
+finally
+  S.Free;
+  end;
+end;
+
+{-------------HtmlParseTextString}
+procedure ThlParser.HtmlParseTextString(ASectionList: TList; ANameList: TStringList);
+begin
+LoadStyle := lsPrimary;
+ParseInit(ASectionList, ANameList, Nil);
+SoundEvent := Nil;
+MetaEvent := NIl;
+Buffer := TParseThread(ParseThread).Buffer;
+BuffEnd := TParseThread(ParseThread).BuffEnd;
+
+try
+  try
+    GetCh; {get the reading started}
+    DoText;
+  except
+    On EParseError do;   {ignore this error}
+  end;
+
+finally
+  Attributes.Free;
+  if Assigned(Section) then
+    SectionList.Add(Section);
+  while StackIndex >= 1 do
+    begin
+    FontStack[StackIndex].Free;
+    Dec(StackIndex);
+    end;
+ end;   {finally}
+end;
+
+constructor ThlParser.Create;
+begin
+inherited;
+LCToken := TokenObj.Create;
+end;
+
+destructor ThlParser.Destroy;
+begin
+LCToken.Free;
+inherited;
+end;
+
+
+end.
+
diff --git a/components/htmllite/litereadthd.pas b/components/htmllite/litereadthd.pas
new file mode 100644
index 0000000000..27706ab5b7
--- /dev/null
+++ b/components/htmllite/litereadthd.pas
@@ -0,0 +1,86 @@
+{*********************************************************}
+{*                   LITEREADTHD.PAS                     *}
+{*                 Copyright (c) 2002 by                 *}
+{*                   L. David Baldwin                    *}
+{*                 All rights reserved.                  *}
+{*********************************************************}
+
+{$i LiteCons.inc}
+
+unit LiteReadThd;
+
+interface
+
+uses
+  Classes, LitePars;
+
+type
+  TParseThread = class(TThread)
+  private
+    { Private declarations }
+  protected
+    procedure Execute; override;
+  public
+    Parser: ThlParser;
+    St: string;
+    ASectionList: TList;
+    AIncludeEvent: TIncludeType;
+    ASoundEvent: TSoundType;
+    AMetaEvent: TMetaType;
+    ANameList: TStringList;
+    Buffer, BuffEnd: PChar;
+    Text: boolean;
+    Done: boolean;
+
+    constructor Create(CreateSuspended: Boolean);
+    destructor Destroy; override;
+    procedure Synchronize(Method: TThreadMethod);
+    procedure AddString(S: string);
+  end;
+
+
+implementation
+
+
+constructor TParseThread.Create(CreateSuspended: Boolean);
+begin
+inherited;
+FreeOnTerminate := False;
+St := '';
+Buffer := PChar(St);
+BuffEnd := Buffer;
+end;
+
+procedure TParseThread.AddString(S: string);
+{Call only when thread is suspended}
+var
+  Space: integer;
+begin
+Space := Buffer - PChar(St);
+St := St + S;
+Buffer := PChar(St) + Space;
+BuffEnd := PChar(St) + Length(St);
+end;
+
+procedure TParseThread.Execute;
+begin
+if Text then
+  Parser.HTMLParseTextString(ASectionList, ANameList)
+else
+  Parser.HTMLParseString(ASectionList, ANameList, AIncludeEvent, ASoundEvent, AMetaEvent);
+ReturnValue := 0;
+Done := True;
+end;
+
+procedure TParseThread.Synchronize(Method: TThreadMethod);
+begin
+  inherited Synchronize(Method);
+end;
+
+destructor TParseThread.Destroy;
+begin
+  inherited;
+end;
+
+end.
+
diff --git a/components/htmllite/litesbs1.pas b/components/htmllite/litesbs1.pas
new file mode 100644
index 0000000000..3d2519cc59
--- /dev/null
+++ b/components/htmllite/litesbs1.pas
@@ -0,0 +1,738 @@
+{Version 7.5}
+{*********************************************************}
+{*                     LITESBS1.PAS                      *}
+{*              Copyright (c) 1995-2002 by               *}
+{*                   L. David Baldwin                    *}
+{*                 All rights reserved.                  *}
+{*********************************************************}
+
+{$i LiteCons.inc}
+
+unit LiteSbs1;
+
+interface
+uses
+  {$IFDEF HL_LAZARUS}
+  Classes, SysUtils, LCLType, LCLLinux, Messages, GraphType, Graphics, Controls,
+  Forms, Dialogs, StdCtrls, ExtCtrls, LiteUn2, LiteSubs;
+  {$ELSE}
+  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
+  Forms, Dialogs, StdCtrls, ExtCtrls, LiteUn2, LiteGif2, LiteSubs;
+  {$ENDIF}
+
+Type
+
+  TParagraphSpace = class(TSectionBase)  {spacing for a 
    }
+    procedure UpdateSpacing; override;
+    procedure CopyToClipboard; override;
+    end;
+
+  THeadingSpace = class(TSectionBase)     {spacing for }
+    HeadingSize: integer;
+
+    constructor Create(AMasterList: TSectionList; AHeadingSize: integer);
+    procedure CopyToClipboard; override;
+    procedure UpdateSpacing; override;
+    end;
+
+  THorzLine = class(TSectionBase)          {a horizontal line, 
    }
+    VSize: integer;
+    HWidth: integer;
+    AsPercent: boolean;
+    Color: TColor;
+    Align: JustifyType;
+    NoShade: boolean;        
+    BkGnd: boolean;
+    constructor Create(AMasterList: TSectionList; L: TAttributeList);
+    procedure CopyToClipboard; override;
+    function DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer; override;
+    function Draw(Canvas: TCanvas; const ARect: TRect;
+         IMgr: IndentManager; X : integer; Y: integer) : integer;  override;
+    procedure UpdateSpacing; override;
+    end;
+
+   TPreFormated = class(TSection)
+  {section for preformated, 
    }
+  public
+    procedure AddTokenObj(S : TokenObj; NoBreak: boolean); override;   
+    function DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer; override;
+    procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); override;
+    end;
+
+ TUListItem = class(TSection)     {Unordered List}
+    Plain: boolean;
+    constructor Create(AMasterList: TSectionList;
+      {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer; AFont: TMyFont;
+                         AnURL: TUrlTarget);
+    end;
+
+  TDListItem = class(TUListItem)     {Definition List}
+    constructor Create(AMasterList: TSectionList;
+      {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer; AFont:
+                TMyFont; AnURL: TUrlTarget);
+    end;
+
+  TOListItem = class(TUListItem)    {Ordered List}
+    IndexType: char;  {1,a,A,i,I}
+    constructor Create(AMasterList: TSectionList;
+      {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}, ItemNumb: integer;
+                Index: char; AFont: TMyFont; AnURL: TUrlTarget);
+    end;
+
+  TListBoxFormControlObj = class(TFormControlObj)
+  { with size = 1, no multiple}
+  public
+    constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
+    procedure ResetToValue; override;
+    procedure SetHeightWidth(Canvas: TCanvas); override;
+    function GetSubmission(Index: integer; var S: string): boolean; override;
+  end;
+
+  TTextAreaFormControlObj = class(TFormControlObj)
+  public
+    Rows, Cols: integer;
+    TheText: TStringList;
+    constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
+    destructor Destroy; override;
+    procedure AddStr(const S: string);
+    procedure ResetToValue; override;
+    procedure SetHeightWidth(Canvas: TCanvas); override;
+    function GetSubmission(Index: integer; var S: string): boolean; override;
+  end;
+
+  TFormControlList = class(TList)  {a list of TFormControlObj's}  {not TFreeList}
+  Public
+    function FindControl(Posn: integer): TFormControlObj;
+    function GetHeightAt(Posn: integer; var BaseLine: boolean) : Integer;
+    function GetWidthAt(Posn: integer) : integer;
+    function GetControlCountAt(Posn: integer): integer;
+    end;
+
+
+Implementation
+
+uses
+  LitePars, htmllite;
+
+{----------------TParagraphSpace.UpdateSpacing}
+procedure TParagraphSpace.UpdateSpacing;
+begin
+SectionHeight := MulDiv(14, ParentSectionList.FontSize, 12);   {scale to FontSize}
+end;
+
+procedure TParagraphSpace.CopyToClipboard;
+begin
+ParentSectionList.CB.AddTextCr('', 0);
+end;
+
+{----------------THeadingSpace.Create}
+constructor THeadingSpace.Create(AMasterList: TSectionList; AHeadingSize: integer);
+begin
+inherited Create(AMasterList);
+HeadingSize := AHeadingSize;
+end;
+
+procedure THeadingSpace.CopyToClipboard;
+begin
+ParentSectionList.CB.AddTextCR('', 0);
+end;
+
+procedure THeadingSpace.UpdateSpacing;
+var
+  SH: integer;
+begin
+case HeadingSize of    {these are just a guess}
+  0: SH := 8;
+  1: SH := 16;
+  2: SH := 12;
+  3: SH := 10;
+  4: SH := 8;
+  5: SH := 6;
+  6: SH := 4;
+  else SH := 8;
+  end;
+SectionHeight := MulDiv(SH, ParentSectionList.FontSize, 12);   {scale to FontSize}
+end;
+
+{----------------THorzLine.Create}
+constructor THorzLine.Create(AMasterList: TSectionList; L: TAttributeList);
+var
+  LwName: string[10];
+  I: integer;
+begin
+inherited Create(AMasterList);
+VSize := 2;
+HWidth := -1;
+Align := Centered;
+for I := 0 to L.Count-1 do
+  with TAttribute(L[I]) do
+    case Which of
+      SizeSy: if (Value > 0) and (Value <= 20) then
+        VSize := Value;
+      WidthSy:
+        if Value > 0 then
+          if Pos('%', Name) > 0 then
+            begin
+            if (Value <= 100) then HWidth := Value;
+            AsPercent := True;
+            end
+          else HWidth := Value;
+      ColorSy: BkGnd := GetColor(Name, Color);
+      AlignSy:
+        begin
+        LwName := Lowercase(Name);
+        if LwName = 'left' then Align := Left
+        else if LwName = 'right' then Align := Right;
+        end;
+      NoShadeSy: NoShade := True;
+      end;
+end;
+
+{----------------THorzLine.UpdateSpacing}
+procedure THorzLine.UpdateSpacing;
+begin
+SectionHeight := MulDiv(20, ParentSectionList.FontSize, 12)
+                   -2 + VSize;   {scale to FontSize}
+end;
+
+procedure THorzLine.CopyToClipboard;
+begin
+ParentSectionList.CB.AddTextCR('', 0);
+end;
+
+function THorzLine.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer;
+begin
+Result := inherited DrawLogic(Canvas, Y, IMgr, MaxWidth, Curs);
+end;
+
+{----------------THorzLine.Draw}
+function THorzLine.Draw(Canvas: TCanvas; const ARect: TRect;
+     IMgr: IndentManager; X: integer; Y: integer) : integer;
+var
+  XR, L, R, W2 : integer;
+  YT, YO: integer;
+  White, BlackBorder: boolean;
+begin
+Result := inherited Draw(Canvas, ARect, IMgr, X, Y);
+YO := Y - ParentSectionList.YOff;
+if (YO+SectionHeight >= ARect.Top) and (YO < ARect.Bottom) then
+  with Canvas do
+    begin
+    YT := YO+(SectionHeight - VSize) div 2;
+    L := IMgr.LeftIndent(Y);
+    R := IMgr.RightSide(Y);
+    if HWidth < 0 then
+      begin
+      X := L+10;
+      XR := R - 10;
+      end
+    else
+      begin
+      if AsPercent then
+        W2 := MulDiv(R-L, HWidth, 100)
+      else W2 := HWidth;
+      case Align of
+        Left: X := L;
+        Centered: X := L + (R - L - W2) div 2;
+        Right: X := R-W2;
+        end;
+      XR := X+W2;
+      end;
+    if BkGnd then
+      begin
+      Brush.Color := Color or $2000000;
+      Brush.Style := bsSolid;
+      FillRect(Rect(X, YT, XR, YT+VSize));
+      end
+    else
+      begin
+      with ParentSectionList do
+        begin
+        White := ((Background and $FFFFFF = clWhite) or
+            ((Background = clWindow) and (GetSysColor(Color_Window) = $FFFFFF)));
+        BlackBorder := NoShade or ((GetDeviceCaps(Handle, BITSPIXEL) = 1) and
+            (GetDeviceCaps(Handle, PLANES) = 1));
+        end;
+      if BlackBorder then Pen.Color := clBlack
+        else Pen.Color := clBtnShadow;
+      MoveTo(X, YT+VSize);
+      LineTo(X, YT);
+      LineTo(XR, YT);
+      if BlackBorder then
+        Pen.Color := clBlack
+      else if White then
+        Pen.Color := clSilver
+      else Pen.Color := clBtnHighLight;
+      LineTo(XR, YT+VSize);
+      LineTo(X, YT+VSize);
+      end;
+    end;
+end;
+
+procedure TPreformated.AddTokenObj(S : TokenObj; NoBreak: boolean);
+var
+  L : integer;
+begin
+if Length(S.S) = 0 then Exit;
+if Len > 20000 then  Exit;
+L := Len+Length(S.S);
+if BuffSize < L+1 then Allocate(L + 100);  {L+1 so there is always extra for font at end}
+Move(S.S[1], (Buff+Len)^, Length(S.S));
+Move(S.I[1], XP^[Len], Length(S.S)*Sizeof(integer));    
+Len := L;
+end;
+
+procedure TPreformated.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer);
+begin
+if Len = 0 then    
+  begin
+  Max := Indent;
+  Min := Indent;
+  end
+else
+  begin
+  Max := FindTextWidth(Canvas, Buff, Len, False) + Indent;
+  Min := IntMin(2000, Max);   {arbitrary selection}
+  end;
+end;
+
+function TPreFormated.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer;
+var
+  Dummy: integer;
+  Save: integer;
+begin
+if Len = 0 then
+  begin
+  Result := DefFont.Size;
+  SectionHeight := Result;
+  MaxWidth := 0;
+  end
+else
+  begin
+  {call with large width to prevent wrapping}
+  Save := IMgr.Width;
+  IMgr.Width := 32000;
+  Result := inherited DrawLogic(Canvas, Y, IMgr, Dummy, Curs);
+  IMgr.Width := Save;
+  MinMaxWidth(Canvas, Dummy, MaxWidth);   {return MaxWidth}
+  end;
+end;
+
+{----------------TUListItem.Create}
+constructor TUListItem.Create(AMasterList: TSectionList;
+  {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer;
+            AFont: TMyFont; AnURL: TUrlTarget);
+begin
+inherited Create(AMasterList, {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF},
+  AFont, AnURL, Left);
+ListType := Unordered;
+end;
+
+constructor TDListItem.Create(AMasterList: TSectionList;
+  {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}: integer;
+                                           AFont: TMyFont; AnURL: TUrlTarget);
+begin
+inherited Create(AMasterList,
+  {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF},
+  AFont, AnURL);  {ancestor is TUListItem}
+ListType := Definition;
+end;
+
+constructor TOListItem.Create(AMasterList: TSectionList;
+  {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF}, ItemNumb:integer;
+            Index: char; AFont: TMyFont; AnURL: TUrlTarget);
+begin
+inherited Create(AMasterList, {$IFDEF HL_LAZARUS}NewLevel{$ELSE}Level{$ENDIF},
+  AFont, AnURL);
+ListNumb := ItemNumb;
+ListType := Ordered;
+IndexType := Index;
+end;
+
+type
+  TOptionObj = class(TObject)   {used by TListBoxFormControlObj}
+    Value: String;
+    Selected: boolean;
+  end;
+
+{----------------TListBoxFormControlObj.Create}
+constructor TListBoxFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList);
+var
+  T: TAttribute;
+  Multiple: boolean;
+  PntPanel: TPaintPanel;
+begin
+inherited Create(AMasterList, Position, L);
+TheOptions := TStringList.Create;
+Multiple := L.Find(MultipleSy, T);
+if L.Find(SizeSy, T) then
+  LBSize := T.Value
+else LBSize := -1;
+Longest := 3;   {the minimum size}
+PntPanel := TPaintPanel(AMasterList.PPanel);
+FControl := TListBox.Create(PntPanel);
+with TListBox(FControl) do
+  begin
+  Top := -400;   {so will be invisible until placed}
+  Font.Name := AMasterList.PreFontName;
+  Font.Size := 10;
+  MultiSelect := Multiple;
+  ExtendedSelect := Multiple;
+  OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
+  OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
+  OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
+  end;
+end;
+
+destructor TListBoxFormControlObj.Destroy;
+var
+  I: integer;
+begin
+for I := 0 to TheOptions.Count-1 do
+  with TOptionObj(TheOptions.Objects[I]) do
+    Free;
+TheOptions.Free;
+inherited Destroy;
+end;
+
+procedure TListBoxFormControlObj.AddStr(const S,
+  {$IFDEF HL_LAZARUS}NewValue{$ELSE}Value{$ENDIF}: string; Selected: boolean);
+var
+  Opt: TOptionObj;
+begin
+Opt := TOptionObj.Create;
+Opt.Value := {$IFDEF HL_LAZARUS}NewValue{$ELSE}Value{$ENDIF};
+Opt.Selected := Selected;
+TheOptions.AddObject(S, Opt);
+Longest := IntMax(Longest, Length(S));
+end;
+
+procedure TListBoxFormControlObj.ResetToValue;
+var
+  I: Integer;
+  Tmp: boolean;
+begin
+with (FControl as TListBox) do
+  begin
+  Clear;
+  for I := 0 to TheOptions.Count-1 do
+    begin
+    Items.Add(TheOptions[I]);
+    Tmp := (TheOptions.Objects[I] as TOptionObj).Selected;
+    if MultiSelect then
+      Selected[I] := Tmp
+    else if Tmp then
+      ItemIndex := I;
+    end;
+  if ItemIndex < 0 then
+    ItemIndex := 0;
+  TopIndex := 0;
+  end;
+end;
+
+procedure TListBoxFormControlObj.SetHeightWidth(Canvas: TCanvas);
+begin
+if not Assigned(FControl.Parent) then
+  begin
+  FControl.Parent := TPaintPanel(MasterList.PPanel);
+  ResetToValue;
+  end;
+with TListBox(FControl) do
+  begin
+  Canvas.Font := Font;
+  if LBSize = -1 then LBSize := IntMax(1, IntMin(8, TheOptions.Count)); 
+  ClientHeight := Canvas.TextHeight('A')*LBSize;
+  ClientWidth := Canvas.TextWidth('A')*Longest + 15;
+  end;
+end;
+
+function TListBoxFormControlObj.GetSubmission(Index: integer;
+              var S: string): boolean;
+begin
+with (FControl as TListBox) do
+  if (Index < Items.Count) then
+      begin
+      Result := True;
+      S := '';
+      if MultiSelect and Selected[Index] or
+                     not MultiSelect and (ItemIndex = Index) then
+        begin
+        S := Self.Name+'=';
+        with TheOptions.Objects[Index] as TOptionObj do
+          if Value <> '' then S := S + Value
+          else S := S + Items[Index];
+        end;
+    end
+  else Result := False;
+end;
+
+{----------------TComboFormControlObj.Create}
+constructor TComboFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList);
+var
+  PntPanel: TPaintPanel;
+begin
+inherited Create(AMasterList, Position, L);
+PntPanel := TPaintPanel(AMasterList.PPanel);
+FControl.Free;   {don't want the inherited one}
+FControl := TComboBox.Create(PntPanel);
+with TComboBox(FControl) do
+  begin
+  Top := -400;   {so will be invisible until placed}
+  Font.Name := AMasterList.PreFontName;
+  Font.Size := 10;
+  Style := csDropDownList;
+  OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
+  OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
+  OnDropDown := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
+  OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
+  end;
+end;
+
+procedure TComboFormControlObj.ResetToValue;
+var
+  I: Integer;
+begin
+with (FControl as TComboBox) do
+  begin
+  Clear;
+  for I := 0 to TheOptions.Count-1 do
+    begin
+    Items.Add(TheOptions[I]);
+    if (TheOptions.Objects[I] as TOptionObj).Selected then
+      ItemIndex := I;
+    end;
+  if ItemIndex < 0 then
+    ItemIndex := 0;
+  end;
+end;
+
+procedure TComboFormControlObj.SetHeightWidth(Canvas: TCanvas);
+var
+  Wid: integer;
+  DC: HDC;
+  A: Char;
+  ExtS: TSize;
+begin
+if not Assigned(FControl.Parent) then
+  begin
+  FControl.Parent := TPaintPanel(MasterList.PPanel);
+  ResetToValue;
+  end;
+with TComboBox(FControl) do
+  begin
+  A := 'A';
+  DC := GetDC(0);
+  {$ifdef Windows}
+  Wid := LoWord(GetTextExtent(DC, @A, 1));
+  {$else}
+  GetTextExtentPoint32(DC, @A, 1, ExtS);
+  Wid := ExtS.cx;
+  {$endif}
+  ReleaseDC(0, DC);
+  ClientWidth := Wid * Longest + 30;
+  end;
+end;
+
+function TComboFormControlObj.GetSubmission(Index: integer;
+              var S: string): boolean;
+begin
+with (FControl as TComboBox) do
+  if (Index < Items.Count) then
+      begin
+      Result := True;
+      S := '';
+      if ItemIndex = Index then
+        begin
+        S := Self.Name+'=';
+        with TheOptions.Objects[Index] as TOptionObj do
+          if Value <> '' then S := S + Value
+          else S := S + Items[Index];
+        end;
+    end
+  else Result := False;
+end;
+
+{----------------TTextAreaFormControlObj.Create}
+constructor TTextAreaFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList);
+var
+  PntPanel: TPaintPanel;
+  I: integer;
+  Wrap: boolean;
+  SB: TScrollStyle;
+begin
+inherited Create(AMasterList, Position, L);
+TheText := TStringList.Create;
+Rows := 5;
+Cols := 30;
+Wrap := False;
+SB := ssBoth;
+
+for I := 0 to L.Count-1 do
+  with TAttribute(L[I]) do
+    case Which of
+      RowsSy: Rows := Value;
+      ColsSy: Cols := Value;
+      WrapSy:
+        if (Lowercase(Name) = 'soft') or (Lowercase(Name) = 'hard') then
+          begin
+          SB := ssVertical;
+          Wrap := True;
+          end;
+      end;
+
+PntPanel := TPaintPanel(AMasterList.PPanel);
+FControl := TMemo.Create(PntPanel);
+with TMemo(FControl) do
+  begin
+  Top := -400;   {so will be invisible until placed}
+  Font.Name := AMasterList.PreFontName;
+  Font.Size := 10;
+  ScrollBars := SB;
+  Wordwrap := Wrap;
+  OnKeyDown := {$IFDEF HL_LAZARUS}@{$ENDIF}MyForm.ControlKeyDown;
+  OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
+  OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
+  OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
+  end;
+end;
+
+destructor TTextAreaFormControlObj.Destroy;
+begin
+TheText.Free;
+inherited Destroy;
+end;
+
+procedure TTextAreaFormControlObj.SetHeightWidth(Canvas: TCanvas);
+begin
+if not Assigned(FControl.Parent) then  
+  begin
+  FControl.Parent := TPaintPanel(MasterList.PPanel);
+  ResetToValue;
+  end;
+with TMemo(FControl) do
+  begin
+  Canvas.Font := Font;
+  ClientHeight := Canvas.TextHeight('A')*Rows + 5;
+  ClientWidth := Canvas.TextWidth('A')*Cols + 5;
+  end;
+end;
+
+procedure TTextAreaFormControlObj.AddStr(const S: string);
+begin
+TheText.Add(S);
+end;
+
+procedure TTextAreaFormControlObj.ResetToValue;
+begin
+with (FControl as TMemo) do
+  begin
+  Lines := TheText;
+  SelStart := 0;
+  SelLength := 0;
+  end;
+end;
+
+function TTextAreaFormControlObj.GetSubmission(Index: integer;
+              var S: string): boolean;
+var
+  I: integer;
+begin
+if Index = 0 then
+  begin
+  Result := True;
+  S := Name+'=';
+  with (FControl as TMemo) do
+    for I := 0 to Lines.Count-1 do
+      begin
+      S := S + Lines[I];
+      if (I < Lines.Count-1) and not WordWrap then
+        S := S + ^M^J;
+      end;
+  end
+else Result := False;
+end;
+
+function TFormControlList.FindControl(Posn: integer): TFormControlObj;
+{find the control at a given character position}
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  if TFormControlObj(Items[I]).Pos = Posn then
+    begin
+    Result := TFormControlObj(Items[I]);
+    Exit;
+    end;
+Result := Nil;
+end;
+
+function TFormControlList.GetHeightAt(Posn: integer;
+              var BaseLine: boolean) : Integer;
+var
+  Ctrl: TFormControlObj;
+begin
+Ctrl := FindControl(Posn);
+if Assigned(Ctrl) then
+  begin
+  Result := Ctrl.FControl.Height;
+  BaseLine := Ctrl.BaseLine;
+  end
+else Result := -1;
+end;
+
+function TFormControlList.GetWidthAt(Posn: integer) : integer;
+var
+  Ctrl: TFormControlObj;
+begin
+Ctrl := FindControl(Posn);
+if Assigned(Ctrl) then
+  Result := Ctrl.FControl.Width
+else Result := -1;
+end;
+
+function TFormControlList.GetControlCountAt(Posn: integer): integer;
+{Return count of chars before the next form control.  0 if at the control,
+ 9999 if no controls after Posn}
+var
+  I, Pos: integer;
+begin
+if Count = 0 then
+  begin
+  Result := 9999;
+  Exit;
+  end;
+I := 0;
+while I < count do
+  begin
+  Pos := TFormControlObj(Items[I]).Pos;
+  if Pos >= Posn then break;
+  Inc(I);
+  end;
+if I = Count then Result := 9999
+else
+  Result := TFormControlObj(Items[I]).Pos - Posn;
+end;
+
+end.
+
diff --git a/components/htmllite/litesubs.pas b/components/htmllite/litesubs.pas
new file mode 100644
index 0000000000..ea4340b4c6
--- /dev/null
+++ b/components/htmllite/litesubs.pas
@@ -0,0 +1,5900 @@
+{Version 7.5}
+{*********************************************************}
+{*                     LITESUBS.PAS                      *}
+{*              Copyright (c) 1995-2002 by               *}
+{*                   L. David Baldwin                    *}
+{*                 All rights reserved.                  *}
+{*********************************************************}
+
+{$i LiteCons.inc}
+
+{
+This module is comprised mostly of the various Section object definitions.
+As the HTML document is parsed, it is divided up into sections.  Some sections
+are quite simple, like TParagraphSpace.  Others are more complex such as
+TSection which can hold a complete paragraph.
+
+The HTML document is then stored as a list, TSectionList, of the various
+sections.
+
+Closely related to TSectionList is TCell.  TCell holds the list of sections for
+each cell in a Table (the ThtmlTable section).  In this way each table cell may
+contain a document of it's own.
+
+The Section objects each store relevant data for the section such as the text,
+fonts, images, and other info needed for formating.
+
+Each Section object is responsible for its own formated layout.  The layout is
+done in the DrawLogic method.  Layout for the whole document is done in the
+TSectionList.DoLogic method which essentially just calls all the Section
+DrawLogic's.  It's only necessary to call TSectionList.DoLogic when a new
+layout is required (when the document is loaded or when its width changes).
+
+Each Section is also responsible for drawing itself (its Draw method).  The
+whole document is drawn with the TSectionList.Draw method.
+}
+
+unit LiteSubs;
+
+{$IFNDEF HL_LAZARUS}
+{$R HTML32.Res}
+{$ENDIF not HL_LAZARUS}
+
+interface
+uses
+  {$IFDEF HL_LAZARUS}
+  Classes, SysUtils, VCLGlobals, LCLType, LCLLinux, Messages,
+  GraphType, Graphics, Controls, Forms, Dialogs, Buttons, StdCtrls, ExtCtrls,
+  LiteUn2, LiteGif2;
+  {$ELSE}
+  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
+  Forms, Dialogs, StdCtrls, ExtCtrls, LiteUn2, LiteGif2, mmSystem;
+  {$ENDIF}
+
+const
+  MaxCols = 200;  {number columns allowed in table}  
+
+type
+  TGetImageEvent = procedure(Sender: TObject; const SRC: string;
+                    var Stream: TMemoryStream) of Object;
+  TFormSubmitEvent = procedure(Sender: TObject; const Action, Target, EncType, Method: string;
+                    Results: TStringList) of Object;
+  TObjectClickEvent = procedure(Sender, Obj: TObject; const OnClick: string) of Object;
+  TExpandNameEvent = procedure(Sender: TObject; const SRC: string; var Result: string) of Object;
+  SubSuperType = (Normal, SubSc, SupSc);
+  TCell = Class;
+  TSectionList = Class;
+  TSection = Class;
+
+  TMyFont = class(TFont)
+  public
+    NormalSize: integer;   {normal unscaled size}
+    Fixed: boolean;        {set if font is fixed font and can't be changed}
+    procedure Assign(Source: TPersistent); override;
+    procedure SetNormalSize(List: TSectionList; Value: integer);
+    procedure UpdateFont(List: TSectionList; NewColor: TColor);
+  end;
+
+  TFontObj = class(TObject)   {font information}
+  private
+    Section: TSection;
+    FVisited, FHover: boolean;
+    procedure SetVisited(Value: boolean);
+    procedure SetHover(Value: boolean);
+    function GetURL: string;
+  public
+    Pos : integer;        {0..Len  Index where font takes effect}
+    TheFont : TMyFont;
+    FontHeight,       {tmHeight+tmExternalLeading}
+    tmHeight,
+    Overhang, Descent : integer;
+    SScript: SubSuperType;  {Normal, SubSc, SupSc}
+    UrlTarget: TUrlTarget;
+    constructor Create(ASection: TSection; F: TMyFont; Position: integer);
+    destructor Destroy; override;
+    procedure UpdateFont;
+    procedure FontChanged(Sender: TObject);
+    function GetOverhang : integer;
+    function GetHeight(var Desc: integer): integer;
+
+    property URL: string read GetURL;     
+    property Visited: boolean read FVisited Write SetVisited;
+    property Hover: boolean read FHover Write SetHover;
+  end;
+
+  TFontList = class(TFreeList)  {a list of TFontObj's}
+  Public
+    procedure UpDateFonts;
+    function GetFontAt(Posn : integer; var OHang : integer) : TMyFont;
+    function GetFontCountAt(Posn, Leng : integer) : integer;
+    function GetFontObjAt(Posn : integer;
+                      var Index : integer) : TFontObj;
+  end;
+
+  TImageFormControlObj = class;
+
+  TFloatingObj = class(TObject)
+  protected
+    Pos : integer;        {0..Len  index of image position}
+    ImageHeight,          {does not include VSpace}  
+    ImageWidth: integer;
+    ObjAlign: AlignmentType;
+    Indent: integer;
+    HSpace, VSpace:  integer;       {horizontal, vertical extra space}  
+  end;
+
+  TImageObj = class(TFloatingObj)   {inline image info} 
+  private
+    FBitmap: TBitmap;
+    FHover, FHoverImage: boolean;
+    function GetBitmap: TBitmap;
+    procedure SetHover(Value: boolean);
+  public
+    SpecHeight, SpecWidth: integer;   {as specified by  tag}
+    PercentWidth: boolean;           {if width is percent}
+    ObjHeight, ObjWidth: integer;   {width as drawn}
+    ImageKnown: boolean;      {know size of image}
+    Source, Alt : String;    {the src= and alt= attributes}
+    NoBorder: boolean;        {set if don't want blue border}
+    Image: TPersistent;  {bitmap possibly converted from GIF, Jpeg, etc or animated GIF}
+    Mask: TBitmap;    {Image's mask if needed for transparency}
+    ParentSectionList: TSectionList;
+    Transparent: Transparency;    {None, Lower Left Corner, or Transp GIF}
+    IsMap, UseMap: boolean;
+    HasBlueBox: boolean;          {Link box drawn around image}
+    DrawX: integer;
+    DrawYY: integer;
+    MapName: String;
+    MyFormControl: TImageFormControlObj;  {if an , 
  • , many other things, and the base for lists}
+  private
+    function GetIndexObj(I: integer): IndexObj;   
+    property PosIndex[I: integer]: IndexObj read GetIndexObj;
+  public
+    Buff : PChar;            {holds the text for the section}
+    XP: PXArray;   
+    BuffSize: integer;       {buffer may be larger}
+    Fonts : TFontList;   {List of FontObj's in this section}
+    Images: TImageObjList;   {list of TImageObj's, the images in section}
+    FormControls: TList;      {list of TFormControls in section}
+    SIndexList: TFreeList;    {list of Source index changes}  
+    Level,            {nesting level of lists}
+    Indent,           {indent of section}
+    ListNumb : integer;  {1, 2, 3, etc for ordered lists}
+    Lines : TFreeList;   {List of LineRecs,  info on all the lines in section}
+    DefFont : TMyFont;
+    ListType: ListTypeType;
+    Justify: JustifyType; {Left, Centered, Right}
+    ClearAttr: ClearAttrType;
+    LevelIndent: integer;   {The indent for this list level}
+
+    constructor Create(AMasterList: TSectionList; ALevel: integer; AFont: TMyFont;
+                AnURL: TUrlTarget; AJustify: JustifyType);
+    destructor Destroy; override;
+    procedure DoClearAttribute(L: TAttributeList);
+    procedure Finish;
+    procedure AddChar(C: char; Index: integer; NoBreak: boolean); 
+    procedure AddTokenObj(S : TokenObj; NoBreak: boolean); virtual;
+    function BreakInfo(Index: integer; NoBreak: boolean): JustifyType;
+    procedure Allocate(N : integer);
+    function AddImage(L: TAttributeList; ACell: TCell; Index: integer; NoBreak: boolean): TImageObj;
+    function AddFormControl(Which: Symb; AMasterList: TSectionList;
+             L: TAttributeList; ACell: TCell; Index: integer; NoBreak: boolean): TFormControlObj;
+    procedure ChangeFont(List: TSectionList; NewFont: TMyFont);
+    procedure ChangeStyle(Sy: Symb);
+    procedure HRef(Sy: Symb; List: TSectionList; AnURL: TUrlTarget;
+              AFont: TMyFont);
+    function FindCountThatFits(Canvas: TCanvas; Width : integer; Start : PChar;
+                                  Max : integer) : integer;
+    function FindCountThatFits1(Canvas: TCanvas; Width : integer;
+                    Start : PChar; Max: integer; Y: integer; IMgr: IndentManager;
+                    var ImgHt: integer; NxImages: TList) : integer;
+    function FindTextWidth(Canvas: TCanvas; Start: PChar; N: integer;
+                           RemoveSpaces: boolean): integer;
+    function DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer; override;
+    function Draw(Canvas: TCanvas; const ARect: TRect;
+         IMgr: IndentManager; X : integer; Y: integer) : integer;  override;
+    procedure CopyToClipboard; override;
+    function GetURL(Canvas: TCanvas; X: integer; Y: integer;
+         var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean; override;
+    function PtInObject(X : integer; Y: integer; var Obj: TObject;
+         var IX, IY: integer): boolean; override;   
+    function FindCursor(Canvas: TCanvas; X: integer; Y: integer;
+         var XR: integer; var YR: integer; var CaretHt: integer;
+         var SCell: TObject; var Intext: boolean): integer; override;
+    function FindString(From: integer; PC: PChar; MatchCase: boolean):
+                              integer; override;
+    function FindSourcePos(DocPos: integer): integer; override;    
+    function FindDocPos(SourcePos: integer; Prev: boolean): integer; override;    
+    procedure UpdateFonts; override;
+    function CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
+             var Y: integer): boolean; override;
+    function GetChAtPos(Pos: integer; var Ch: char; var Obj: TObject): boolean; override;
+    procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); override;
+    end;
+
+  TCell = class(TFreeList)   {a list which holds sections of a table cell}
+    MasterList: TSectionList;  {the TSectionList that holds the whole document}
+    FontSize: integer;
+    YValue: integer;   {vertical position at top of cell}
+    StartCurs: integer;
+    Len: integer;
+    IMgr: IndentManager;
+    BkGnd: boolean;
+    BkColor: TColor;
+
+    constructor Create(Master: TSectionList);
+    destructor Destroy; override;
+    procedure Add(Item: TSectionBase);
+    procedure CopyToClipboard;
+    procedure UpdateFonts;
+    function DoLogic(Canvas: TCanvas; Y: integer; Width: integer;
+                  var ScrollWidth: integer; var Curs: integer;
+                  StartY,  StartCount: integer): integer; virtual;
+    procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); virtual;
+    function Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer;
+                          Y:integer): integer; virtual;
+    function FindSectionAtPosition(Pos: integer;
+             var TopPos: integer; var Index: integer): TSectionBase;
+    function GetURL(Canvas: TCanvas; X: integer; Y: integer;
+             var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean; virtual;
+    function PtInObject(X: integer; Y: integer;  var Obj: TObject;  
+              var IX, IY: integer): boolean;
+    function FindCursor(Canvas: TCanvas; X: Integer; Y: integer;
+                var XR: integer; var YR: integer; var Ht: integer;
+                var SCell: TObject; var Intext: boolean): integer;
+    function FindString(From: integer; PC: PChar; MatchCase: boolean): integer;
+    function FindSourcePos(DocPos: integer): integer;     
+    function FindDocPos(SourcePos: integer; Prev: boolean): integer;     
+    function CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
+             var Y: integer): boolean;
+    function GetChAtPos(Pos: integer; var Ch: char; var Obj: TObject): boolean;
+    end;
+
+  TSectionList = class(TCell)    {a list of all the sections--holds document}
+  Private
+    procedure AdjustFormControls;
+  Public
+    ShowImages: boolean;     {set if showing images}
+    YOff: integer;           {marks top of window that's displayed}
+    YOffChange: boolean;     {when above changes}
+    NoPartialLine: boolean;  {set when printing if no partial line allowed
+                              at page bottom}
+    SelB, SelE: integer;
+    FontName : string[lf_FaceSize+1];  {font info for document}
+    PreFontName : string[lf_FaceSize+1];  {
    ,  font for document}
+    FontColor,
+    LinkVisitedColor, LinkActiveColor,
+    HotSpotColor: TColor;
+    {$ifdef ver100_plus}
+    Charset: TFontCharset;
+    {$endif}
+    UnLine: TFontStyles;      {[fsUnderline] or [] depending on htNoLinkUnderline}
+    TheOwner: TWinControl;        {the viewer that owns this document}
+    PPanel: TWinControl;          {the viewer's PaintPanel}
+    GetImage: TGetImageEvent;     {for OnImageRequest Event}
+    ExpandName: TExpandNameEvent;
+    ObjectClick: TObjectClickEvent;
+    BackGround: TColor;
+    OnBackgroundChange: TNotifyEvent;
+    BackgroundBitmap: TBitmap;
+    BackgroundMask: TBitmap;
+    BitmapName: String;      {name of background bitmap}
+    BitmapLoaded: boolean;   {if background bitmap is loaded}
+    htmlFormList: TFreeList;
+    AGifList: TList;      {list of all animated Gifs}
+    SubmitForm: TFormSubmitEvent;
+    ScriptEvent: TScriptEvent;
+    CB: SelTextCount;
+    PageBottom: integer;
+    MapList: TFreeList;    {holds list of client maps, TMapItems}
+    Timer: TTimer;      {for animated GIFs}
+    FormControlList:  TList;   {List of all TFormControlObj's in this SectionList}
+    MissingImages: TStringList;  {images to be supplied later}
+    ControlEnterEvent: TNotifyEvent;
+    LinkList: TList;    {List of links (TFontObj's)}
+    ActiveLink: TFontObj;
+    LinksActive: boolean;
+    ActiveImage: TImageObj;
+    ShowDummyCaret: boolean;
+    Parser: TObject;
+
+    constructor Create(Owner, APaintPanel: TWinControl);
+    procedure Clear;
+    destructor Destroy; override;
+    procedure CheckGIFList(Sender: TObject);
+    procedure SetYOffset(Y: integer);
+    function GetSelLength: integer;
+    function GetSelTextBuf(Buffer: PChar; BufSize: integer): integer;
+    procedure SetFonts(const Name, PreName: String; ASize: integer;
+              AColor, AHotSpot, AVisitedColor, AActiveColor, ABackground: TColor;
+              LnksActive: boolean);
+    procedure SetBackground(ABackground: TColor);
+    procedure SetBackgroundBitmap(Name: String);
+    function GetBackgroundBitmap: TBitmap;
+    function FindPositionByIndex(Index: integer): integer;
+    procedure CancelActives;
+    function GetURL(Canvas: TCanvas; X: integer; Y: integer;
+             var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean; override;
+    function GetTheBitmap(const BMName: String; var Transparent: Transparency;
+               var AMask: TBitmap; var FromCache, Delay: boolean): TPersistent;
+    function DoLogic(Canvas: TCanvas; Y: integer; Width: integer;
+                  var ScrollWidth: integer; var Curs: integer;
+                  StartY,  StartCount: integer): integer; override;
+    function Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer;
+                          Y:integer): integer; override;
+    procedure InsertImage(const Src: string; Stream: TMemoryStream; var Reformat: boolean);
+  end;
+
+  TCellObj = class(TObject)  {holds a TCell and some other information}
+    ColSpan, RowSpan,      {column and row spans for this cell}
+    Wd: integer;  {total width (may cover more than one column)}
+    Ht,           {total height (may cover more than one row)}
+    VSize: integer;     {Actual vertical size of contents}
+    SpecHt: integer;    {Height as specified}
+    YIndent: integer;   {Vertical indent}
+    VAlign: AlignmentType;  {Top, Middle, or Bottom}
+    WidthAttr: integer;   {Width attribute (percentage or absolute)}
+    AsPercent: boolean;   {it's a percent}
+    Cell: TCell;
+
+    constructor Create(Master: TSectionList; AVAlign: AlignmentType;
+                Attr: TAttributeList);
+    destructor Destroy; override;
+    procedure UpdateFonts;
+    end;
+
+const
+  SmallListIndent = 15;  {for 
  •  without 
      }
+  ImageSpace = 5;   {extra space for left, right images}
+
+var
+  ListIndent: integer = 35;  {defines successive indents}  
+
+implementation
+
+uses htmllite, LitePars, LiteSbs1, LiteReadThd;
+
+type
+  TSectionClass = Class of TSectionBase;
+  EProcessError = class(Exception);
+
+procedure IndentManager.Update(Y: integer; Img: TFloatingObj);
+{Given a new floating image, update the edge information.  Fills  Img.Indent,
+ the distance from the left edge to the upper left corner of the image}
+var
+  IH, IW: integer;
+  IR: IndentRec;
+begin
+if Assigned(Img) then
+  begin
+  IW := Img.ImageWidth + Img.HSpace;
+  IH := Img.ImageHeight + 2*Img.VSpace;               
+  if (Img.ObjAlign = ALeft) then   
+    begin
+    IR := IndentRec.Create;
+    with IR do
+      begin
+      Img.Indent := LeftIndent(Y)-LfEdge;
+      X := Img.Indent + IW;               
+      YT := Y;
+      YB := Y + IH;
+      Lev := 0;
+      L.Add(IR);
+      end;
+    end
+  else if (Img.ObjAlign = ARight) then  
+    begin
+    IR := IndentRec.Create;
+    with IR do
+      begin
+      X := RightSide(Y) - RtEdge - IW;
+      Img.Indent := X + RtEdge + Img.HSpace;
+      YT := Y;
+      YB := Y + IH;
+      Lev := 0;
+      R.Add(IR);
+      end;
+    end;
+  end;
+end;
+
+{----------------TMyFont.Assign}
+procedure TMyFont.Assign(Source: TPersistent);
+begin
+if Source is TMyFont then
+  begin
+  NormalSize := TMyFont(Source).NormalSize;
+  Fixed := TMyFont(Source).Fixed;
+  end;
+inherited Assign(Source);
+end;
+
+procedure TMyFont.SetNormalSize(List: TSectionList; Value: integer);
+begin
+NormalSize := Value;
+Size := MulDiv(List.FontSize, Value, 12);
+end;
+
+procedure TMyFont.UpdateFont(List: TSectionList; NewColor: TColor);
+begin
+if not Fixed then Name := List.FontName
+  else Name := List.PreFontName;
+{$ifdef ver100_plus}    
+Charset := List.Charset;
+{$endif}
+Size := MulDiv(List.FontSize, NormalSize, 12);  {Scale the font size}
+Color := NewColor or $2000000;   
+end;
+
+constructor TFontObj.Create(ASection: TSection; F: TMyFont; Position: integer);
+begin
+inherited Create;
+Section := ASection;
+TheFont := F;
+TheFont.OnChange := {$IFDEF HL_LAZARUS}@{$ENDIF}FontChanged;
+Pos := Position;
+UrlTarget := TUrlTarget.Create;
+FontChanged(Self);
+end;
+
+destructor TFontObj.Destroy;
+begin
+TheFont.Free;
+UrlTarget.Free;
+inherited Destroy;
+end;
+
+procedure TFontObj.SetVisited(Value: boolean);
+begin
+if Value <> FVisited then
+  begin
+  FVisited := Value;
+  if FHover then
+    TheFont.Color := Section.ParentSectionList.LinkActiveColor or $2000000
+  else if Value then
+    TheFont.Color := Section.ParentSectionList.LinkVisitedColor or $2000000
+  else
+    TheFont.Color := Section.ParentSectionList.HotspotColor or $2000000;
+  end;
+end;
+
+procedure TFontObj.SetHover(Value: boolean);
+begin
+if Value <> FHover then
+  begin
+  FHover := Value;
+  if FHover then
+    TheFont.Color := Section.ParentSectionList.LinkActiveColor or $2000000
+  else if FVisited then
+    TheFont.Color := Section.ParentSectionList.LinkVisitedColor or $2000000
+  else
+    TheFont.Color := Section.ParentSectionList.HotspotColor or $2000000;
+  end;
+end;
+
+function TFontObj.GetURL: string;      
+begin
+Result := UrlTarget.Url;
+end;
+
+procedure TFontObj.UpdateFont;   
+var
+  Color: TColor;
+begin
+if UrlTarget.Url <> '' then Color := Section.ParentSectionList.HotSpotColor
+else Color := Section.ParentSectionList.FontColor;
+TheFont.UpdateFont(Section.ParentSectionList, Color);
+end;
+
+procedure TFontObj.FontChanged(Sender: TObject);
+var
+  Save: THandle;
+  tm : TTextmetric;
+  DC: HDC;
+begin
+DC := GetDC(0);
+Save := SelectObject(DC, TheFont.Handle);
+GetTextMetrics(DC, tm);
+tmHeight := tm.tmHeight;
+FontHeight := tm.tmHeight + tm.tmExternalLeading;
+Descent := tm.tmDescent;
+Overhang := tm.tmOverhang;
+SelectObject(DC, Save);
+ReleaseDC(0, DC);
+end;
+
+function TFontObj.GetOverhang: integer;
+begin
+Result := Overhang;
+end;
+
+function TFontObj.GetHeight(var Desc: integer): integer;
+begin
+Desc := Descent;
+Result := FontHeight;
+end;
+
+procedure TFontList.UpDateFonts;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  TFontObj(Items[I]).UpdateFont;
+end;
+
+function TFontList.GetFontAt(Posn : integer;
+                var OHang : integer) : TMyFont;
+{given a character index, find the font that's effective there}
+var
+  I, PosX: integer;
+  F : TFontObj;
+begin
+I := 0;
+PosX := 0;
+while (I < Count)  do
+  begin
+  PosX := TFontObj(Items[I]).Pos;
+  Inc(I);
+  if PosX >= Posn then Break;
+  end;
+Dec(I);
+if PosX > Posn then Dec(I);
+F := TFontObj(Items[I]);
+OHang := F.GetOverhang;
+Result := F.TheFont;
+end;
+
+function TFontList.GetFontCountAt(Posn, Leng : integer) : integer;
+{Given a position, return the number of chars before the font changes}
+var
+  I, PosX : integer;
+begin
+I := 0;
+PosX := 0;
+while I < Count do
+  begin
+  PosX := TFontObj(Items[I]).Pos;
+  if PosX >= Posn then Break;
+  Inc(I);
+  end;
+if PosX = Posn then Inc(I);
+if I = Count then
+  Result := Leng-Posn
+else
+  Result := TFontObj(Items[I]).Pos - Posn;
+end;
+
+{----------------TFontList.GetFontObjAt}
+function TFontList.GetFontObjAt(Posn : integer;
+                      var Index : integer) : TFontObj;
+{Given a position, returns the FontObj which applies there and the index of
+ the FontObj in the list}
+var
+  PosX: integer;
+begin
+Index := 0;
+PosX := 0;
+while (Index < Count)  do
+  begin
+  PosX := TFontObj(Items[Index]).Pos;
+  Inc(Index);
+  if PosX >= Posn then Break;
+  end;
+Dec(Index);
+if PosX > Posn then Dec(Index);
+Result := TFontObj(Items[Index]);
+end;
+
+{----------------TImageObj.Create}
+constructor TImageObj.Create(Position: integer; L: TAttributeList);
+var
+  I: integer;
+  S: string;
+  NewSpace: integer;  
+begin
+inherited Create;
+Pos := Position;
+ObjAlign := ABottom;   {default}  
+NewSpace := -1;  
+for I := 0 to L.Count-1 do
+  with TAttribute(L[I]) do
+    case Which of
+      SrcSy: Source := Name;
+      AltSy: Alt := Name;
+      IsMapSy:  IsMap := True;
+      UseMapSy:
+        begin
+        UseMap := True;
+        S := Trim(Uppercase(Name));
+        if (Length(S) > 1) and (S[1] = '#') then
+          System.Delete(S, 1, 1);
+        MapName := S;
+        end;
+      AlignSy:
+        begin
+        S := UpperCase(Name);
+        if S = 'TOP' then ObjAlign := ATop
+        else if (S = 'MIDDLE') or (S = 'ABSMIDDLE') then ObjAlign := AMiddle
+        else if S = 'LEFT' then ObjAlign := ALeft
+        else if S = 'RIGHT' then ObjAlign := ARight;
+        end;
+      BorderSy: NoBorder := Value = 0;
+      TranspSy: Transparent := LLCorner;
+      HeightSy: SpecHeight := Intmax(1, Value); {spec ht of 0 becomes 1}  
+      WidthSy: if System.Pos('%', Name) = 0 then
+                   SpecWidth := Value
+               else if (Value > 0) and (Value <=100) then
+                 begin
+                 SpecWidth := Value;
+                 PercentWidth := True;
+                 end;
+      HSpaceSy:  NewSpace := IntMin(40, Abs(Value));  
+      VSpaceSy:  VSpace := IntMin(40, Abs(Value));   
+      ActiveSy:  FHoverImage := True;
+      end;
+if NewSpace >= 0 then
+  HSpace := NewSpace
+else if ObjAlign in [ALeft, ARight] then
+  HSpace := ImageSpace   {default}
+else HSpace := 0;
+end;
+
+destructor TImageObj.Destroy;
+begin
+if (Source <> '') then
+  BitmapList.DecUsage(Source);
+if (Image is TGifImage) and TGifImage(Image).IsCopy then   
+  Image.Free;
+FBitmap.Free;
+inherited Destroy;
+end;
+
+function TImageObj.GetBitmap: TBitmap;    
+begin
+Result := Nil;
+if Image = ErrorBitmap then Exit;
+if (Image is TGifImage) then
+  Result := TGifImage(Image).Bitmap
+else if (Image is TBitmap) then
+  begin
+  if Assigned(FBitmap) then
+    Result := FBitmap
+  else
+    begin
+    FBitmap := TBitmap.Create;
+    FBitmap.Assign(TBitmap(Image));
+    FBitmap.Palette := CopyPalette(ThePalette);
+    Result := FBitmap;
+    end;
+  end;
+end;
+
+procedure TImageObj.SetHover(Value: boolean);
+begin
+if (Value <> FHover) and FHoverImage and (Image is TGifImage) then
+  with TGifImage(Image) do
+    begin
+    if Value then
+      if NumFrames = 2 then
+        CurrentFrame := 2
+      else
+        begin
+        Animate := True;
+        ParentSectionList.AGifList.Add(Image);
+        end
+    else
+      begin
+      Animate := False;
+      CurrentFrame := 1;
+      ParentSectionList.AGifList.Remove(Image);
+      end;
+    FHover := Value;
+    end;
+end;
+
+{----------------TImageObj.InsertImage}
+function TImageObj.InsertImage(const UName: string; var Reformat: boolean): boolean;   
+var
+  TmpImage: TPersistent;
+  FromCache, IsAniGIF, Delay: boolean;
+begin
+Result := False;
+Reformat := False;
+if (Image = DefBitmap) then
+  begin
+  Result := True;
+  TmpImage := ParentSectionList.GetTheBitmap(UName, Transparent, Mask, FromCache, Delay);
+  if not Assigned(TmpImage) then Exit;
+  IsAniGIF := TmpImage is TGifImage;
+
+  if IsAniGIF then
+    begin
+    if FromCache then   {it would be}
+      Image := TGifImage.CreateCopy(TGifImage(TmpImage))  {it's in Cache already, make copy}
+    else
+      Image := TmpImage;
+    ParentSectionList.AGifList.Add(Image);
+    TGifImage(Image).Animate := True;
+    if Assigned(ParentSectionList.Timer) then   
+      ParentSectionList.Timer.Enabled := True;
+    end
+  else Image := TmpImage;
+
+  if not ImageKnown then
+    begin      {need to get the dimensions}
+    Reformat := True;
+    end;
+  end;
+end;
+
+{----------------TImageObj.DrawLogic}
+procedure TImageObj.DrawLogic(SectionList: TSectionList; Canvas: TCanvas;
+              FO: TFontObj; AvailableWidth: integer);
+{calculate the height and width}
+var
+  TmpImage: TPersistent;
+  ImHeight, ImWidth: integer;
+  ViewImages, FromCache, Delay: boolean;
+  AltWidth, AltHeight: integer;
+  Rslt: string;
+
+begin
+ParentSectionList := SectionList;
+ViewImages := SectionList.ShowImages;
+Delay := False;
+
+TmpImage := Image;
+if ViewImages and not Assigned(TmpImage) then
+  begin
+  if Source <> '' then
+    with SectionList do
+      begin
+      if not Assigned(GetImage) then
+        Source := (TheOwner as ThtmlLite).HTMLExpandFilename(Source)
+      else if Assigned(ExpandName) then   
+        begin
+        ExpandName(TheOwner, Source, Rslt);
+        Source := Rslt;
+        end;
+      if MissingImages.IndexOf(Uppercase(Source)) = -1 then
+        TmpImage := ParentSectionList.GetTheBitmap(Source, Transparent, Mask, FromCache, Delay)
+      else Delay := True;  {already in list, don't request it again}  
+      end;
+  if not Assigned(TmpImage) then
+    begin
+    if Delay then  
+      begin
+      Image := DefBitmap;
+      TmpImage := DefBitmap;
+      ParentSectionList.MissingImages.AddObject(Source, Self); {add it even if it's there already}  
+      end
+    else
+      begin
+      Image := ErrorBitmap;
+      TmpImage := ErrorBitmap;
+      Mask := ErrorBitmapMask;
+      Transparent := LLCorner;
+      end;
+    end
+  else if TmpImage is TGifImage then
+    begin
+    if FromCache then
+      begin  {it's in Cache already, make copy}
+      Image := TGifImage.CreateCopy(TGifImage(TmpImage));
+      TmpImage := Image;
+      end
+    else
+      Image := TmpImage;
+    if not FHoverImage then    
+      ParentSectionList.AGifList.Add(Image)
+    else TGifImage(Image).Animate := False;
+    end
+  else Image := TBitmap(TmpImage);
+  end;
+if not ViewImages then
+  TmpImage := DefBitMap;
+
+if TmpImage is TGifImage then
+  begin
+  ImHeight := TGifImage(TmpImage).Height;
+  ImWidth := TGifImage(TmpImage).Width;
+  end
+else
+  begin
+  ImHeight := TBitmap(TmpImage).Height;
+  ImWidth := TBitmap(TmpImage).Width;
+  end;
+
+if not ImageKnown then
+  if not ((Image = ErrorBitmap) or (TmpImage = DefBitmap)) then
+    begin
+    if PercentWidth then
+      begin
+      ObjWidth := MulDiv(AvailableWidth, SpecWidth, 100);
+      if SpecHeight <> 0 then ObjHeight := SpecHeight
+        else ObjHeight := ImHeight;
+      end
+    else if (SpecWidth <> 0) and (SpecHeight <> 0) then
+      begin       {Both width and height specified}
+      ObjHeight := SpecHeight;
+      ObjWidth := SpecWidth;
+      ImageKnown := True;
+      end
+    else if SpecHeight <> 0 then
+      begin
+      ObjHeight := SpecHeight;
+      ObjWidth := MulDiv(SpecHeight, ImWidth, ImHeight);
+      ImageKnown := True;
+      end
+    else if SpecWidth <> 0 then
+      begin
+      ObjWidth := SpecWidth;
+      ObjHeight := MulDiv(SpecWidth, ImHeight, ImWidth);
+      ImageKnown := True;
+      end
+    else
+      begin       {neither height and width specified}
+      ObjHeight := ImHeight;
+      ObjWidth := ImWidth;
+      ImageKnown := True;
+      end;
+    end
+  else {don't know the image yet}
+    if (SpecHeight <> 0) and (SpecWidth <> 0) then
+      begin       {Both width and height specified}
+      ObjHeight := SpecHeight;
+      ObjWidth := SpecWidth;
+      ImageKnown := True;   {do know the image size}
+      end
+    else
+      begin       {neither height and width specified}
+      ObjHeight := ImHeight;
+      ObjWidth := ImWidth;
+      end;
+
+if (not ViewImages or (TmpImage = ErrorBitmap) or (Image = DefBitmap))
+       and Not ImageKnown then
+  begin
+  Canvas.Font.Name := 'Arial';{use same font as in Draw}
+  Canvas.Font.Size := 8;      {should be option?}
+  if Alt <> '' then
+    begin
+    AltWidth := Canvas.TextWidth(Alt) + 2;
+    AltHeight := Canvas.TextHeight(Alt);
+    end
+  else
+    begin
+    AltHeight := 0;
+    AltWidth := 0;
+    end;
+  ObjWidth := IntMax(ObjWidth, 16+8 + AltWidth);
+  ObjHeight := IntMax(ObjHeight, IntMax(16+8, AltHeight));
+  end;
+
+ImageHeight := ObjHeight;
+ImageWidth := ObjWidth;
+
+HasBlueBox := (FO.URLTarget.Url <> '') and not NoBorder;
+
+if HasBlueBox then
+  begin
+  Inc(ImageHeight, 2);      {extra pixel top and bottom for rectangle}
+  Inc(ImageWidth, 2);
+  end;
+end;
+
+procedure TImageObj.Draw(Canvas: TCanvas; X: integer; TopY, YBaseline: integer;
+                                 FO: TFontObj);
+var
+  TmpImage: TPersistent;
+  TmpMask: TBitmap;
+  MiddleAlignTop: integer;
+  ViewImages: boolean;
+  SubstImage: boolean;
+  Ofst: integer;
+  SaveColor: TColor;
+
+  procedure DoDraw(XX: integer; Y: integer);
+  var
+    DC: HDC;
+    Img: TBitmap;
+
+    function PrintTransparentBitmap(Bitmap, Mask: TBitmap): HBitmap;
+    var
+      DC, MemDC: HDC;
+      OldPal: HPalette;
+      TmpBitmap: HBitmap;
+    begin
+    DC := GetDC(0);
+    MemDC := CreateCompatibleDC(DC);
+    try
+      Result := CreateCompatibleBitmap(DC, Bitmap.Width, Bitmap.Height);
+      TmpBitmap := SelectObject(MemDC, Result);
+      OldPal := SelectPalette(MemDC, ThePalette, False);
+      RealizePalette(MemDC);
+      BitBlt(MemDC, 0, 0, Bitmap.Width, Bitmap.Height, Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
+      BitBlt(MemDC, 0, 0, Bitmap.Width, Bitmap.Height, Mask.Canvas.Handle, 0, 0, SRCPAINT);
+      SelectObject(MemDC, TmpBitmap);
+      SelectPalette(MemDC, OldPal, False);
+    finally
+      DeleteDC(MemDC);
+      ReleaseDC(0, DC); 
+      end;
+    end;
+
+  begin
+  if (TmpImage is TGifImage) then
+    with TGifImage(TmpImage) do
+      begin
+      ShowIt := True;
+      Visible := True;
+      Draw(Canvas, ParentSectionList, MyCell, XX, Y, ObjWidth, ObjHeight);
+      Exit;
+      end;
+  DC := Canvas.Handle;
+  try
+    if ((Transparent <> NotTransp) or (TmpImage = ErrorBitmap)) and Assigned(TmpMask) then
+      if TmpImage = ErrorBitmap then
+        FinishTransparentBitmap(DC, TBitmap(TmpImage), Mask, XX, Y,
+                    TBitmap(TmpImage).Width, TBitmap(TmpImage).Height)
+      else
+        FinishTransparentBitmap(DC, TBitmap(TmpImage), Mask, XX, Y, ObjWidth, ObjHeight)
+    else
+      begin
+      Img := TBitmap(TmpImage);
+      if (TmpImage = DefBitMap) or (TmpImage = ErrorBitmap) then
+        BitBlt(DC, XX, Y, Img.Width, Img.Height, Img.Canvas.Handle, 0, 0, SRCCOPY)
+      else
+        begin
+        SetStretchBltMode(DC, ColorOnColor);
+        StretchBlt(DC, XX, Y, ObjWidth, ObjHeight, Img.Canvas.Handle, 0, 0, Img.Width, Img.Height, SRCCOPY);
+        end;
+      end;
+  except
+    end;
+  end;
+
+begin
+with ParentSectionList do
+  begin
+  ViewImages := ShowImages;
+  Dec(TopY, YOff);
+  Dec(YBaseLine, YOff);
+  end;
+if ViewImages then
+  begin
+  TmpImage := Image;
+  if Image is TBitmap then
+    TmpMask := Mask;
+  end
+else
+  begin
+  TmpImage := DefBitMap;
+  TmpMask := Nil;
+  end;
+SubstImage := not ViewImages or (TmpImage = ErrorBitmap) or (TmpImage = DefBitmap); {substitute image}
+
+with Canvas do
+  begin
+  Brush.Style := bsClear;
+  SaveColor := Font.Color;
+  Font.Color := clBlack;  {else transparent won't work for blue text}
+  Font.Size := 8;
+  Font.Name := 'Arial';        {make this a property?}
+  if SubstImage then Ofst := 4 else Ofst := 0;
+  if ObjAlign = AMiddle then
+    MiddleAlignTop := YBaseLine+FO.Descent-(FO.tmHeight div 2)-(ImageHeight div 2)
+  else MiddleAlignTop := 0;   {not used}
+  
+  DrawX := X;
+  case ObjAlign of      
+      ATop: DrawYY := TopY;   
+      ALeft, ARight: DrawYY := TopY+VSpace;   
+      AMiddle: DrawYY := MiddleAlignTop;
+      ABottom: DrawYY := YBaseLine-ImageHeight;
+      end;
+  if HasBlueBox then
+    begin
+    Inc(DrawX, 1);
+    Inc(DrawYY, 1);
+    end;
+
+  if not SubstImage or (ObjHeight >= 16+8) and (ObjWidth >= 16+8) then
+    DoDraw(DrawX+Ofst, DrawYY+Ofst);
+  Inc(DrawYY, ParentSectionList.YOff);  
+  SetTextAlign(Canvas.Handle, TA_Top);
+  if SubstImage and not HasBlueBox then
+    begin
+    Font.Color := SaveColor;
+    {calc the offset from the image's base to the alt= text baseline}
+    case ObjAlign of
+      ATop, ALeft, ARight:
+        begin
+        if Alt <> '' then
+          WrapText(Canvas, X+24, TopY+Ofst+VSpace, X+ObjWidth-2, TopY+ObjHeight-1+VSpace, Alt);
+        RaisedRect(ParentSectionList, Canvas, X, TopY+VSpace,    
+                                      X+ObjWidth-1, TopY+ObjHeight-1+VSpace, False);
+        end;
+      AMiddle:
+        begin   {MiddleAlignTop is always initialized}
+        if Alt <> '' then
+          WrapText(Canvas, X+24, MiddleAlignTop+Ofst, X+ObjWidth-2,
+              MiddleAlignTop+ObjHeight-1, Alt);
+        RaisedRect(ParentSectionList, Canvas, X, MiddleAlignTop,
+                         X+ObjWidth-1, MiddleAlignTop+ObjHeight-1, False);
+        end;
+      ABottom:
+        begin
+        if Alt <> '' then
+          WrapText(Canvas, X+24, YBaseLine-ObjHeight+Ofst, X+ObjWidth-2,
+                   YBaseLine-1, Alt);
+        RaisedRect(ParentSectionList, Canvas, X, YBaseLine-ObjHeight,
+                                      X+ObjWidth-1, YBaseLine-1, False);
+        end;
+      end;
+    end;
+  if HasBlueBox then
+    begin
+    Pen.Color := FO.TheFont.Color;
+    Font.Color := Pen.Color;
+    if (Alt <> '') and SubstImage then  {output Alt message}
+      case ObjAlign of
+        ATop, ALeft, ARight:
+          WrapText(Canvas, X+24, TopY+Ofst, X+ObjWidth-2, TopY+ObjHeight-1, Alt);
+        AMiddle:
+          WrapText(Canvas, X+24, MiddleAlignTop+Ofst, X+ObjWidth-2,
+              MiddleAlignTop+ObjHeight-1, Alt);
+        ABottom:
+          WrapText(Canvas, X+24, YBaseLine-ObjHeight+Ofst, X+ObjWidth-2,
+                   YBaseLine-1, Alt);
+        end;
+    case ObjAlign of   {draw blue box}
+      ATop: Rectangle(X, TopY, X+ImageWidth, TopY+ImageHeight);  
+      ALeft, ARight: Rectangle(X, TopY+VSpace, X+ImageWidth, TopY+VSpace+ImageHeight);  
+      AMiddle: Rectangle(X, MiddleAlignTop, X+ImageWidth, MiddleAlignTop + ImageHeight);
+      ABottom: Rectangle(X, YBaseLine-ImageHeight, X+ImageWidth, YBaseLine);
+      end;
+    end;
+  end;
+end;
+
+function TImageObjList.FindImage(Posn: integer): TFloatingObj;
+{find the image at a given character position}
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  if TFloatingObj(Items[I]).Pos = Posn then  
+    begin
+    Result := TFloatingObj(Items[I]);
+    Exit;
+    end;
+Result := Nil;
+end;
+
+function TImageObjList.GetHeightAt(Posn: integer; var AAlign: AlignmentType) : Integer;
+var
+  Img: TFloatingObj;  
+begin
+Img := FindImage(Posn);
+if Assigned(Img) then
+  begin
+  Result := Img.ImageHeight;
+  AAlign := Img.ObjAlign;
+  end
+else Result := -1;
+end;
+
+function TImageObjList.GetWidthAt(Posn: integer; var AAlign: AlignmentType; var HSpc: integer) : integer;
+var
+  Img: TFloatingObj;  
+begin
+Img := FindImage(Posn);
+if Assigned(Img) then
+  begin
+  Result := Img.ImageWidth;
+  AAlign := Img.ObjAlign;
+  HSpc := Img.HSpace;    
+  end
+else Result := -1;
+end;
+
+function TImageObjList.GetImageCountAt(Posn: integer): integer;
+{Return count of chars before the next image.  0 if at the image, 9999 if no
+ images after Posn}
+var
+  I, Pos: integer;
+begin
+if Count = 0 then
+  begin
+  Result := 9999;
+  Exit;
+  end;
+I := 0;
+while I < count do
+  begin
+  Pos := TFloatingObj(Items[I]).Pos;
+  if Pos >= Posn then break;
+  Inc(I);
+  end;
+if I = Count then Result := 9999
+else
+  Result := TFloatingObj(Items[I]).Pos - Posn;
+end;
+
+function TImageObjList.PtInImage(X: integer; Y: integer; var IX, IY, Posn: integer;
+                var AMap, UMap: boolean; var MapItem: TMapItem;
+                var ImageObj: TImageObj): boolean;
+var
+  I, J, LimX, LimY: integer;
+  LIY: integer;
+  Obj: TObject;   
+begin
+Result := False;
+for I := 0 to Count-1 do
+  begin
+  Obj := TObject(Items[I]);
+  if Obj is TImageObj then
+    with TImageObj(Obj) do
+      begin
+      IX := X-DrawX;    {these are actual image, box if any is outside}
+      LIY := Y - DrawYY;
+      if HasBlueBox then begin LimX := ImageWidth-2; Limy := ImageHeight-2; end
+        else begin LimX := ImageWidth; Limy := ImageHeight; end;
+      if (IX >= 0) and (IX < LimX) and (LIY >= 0) and (LIY < LimY) then
+        begin
+        IY := LIY;
+        Result := True;
+        AMap := IsMap;
+        Posn := Pos;
+        UMap := False;
+        ImageObj := TImageObj(Obj);   
+        if UseMap then
+          with ParentSectionList.MapList do
+            for J := 0 to Count-1 do
+              begin
+              MapItem := TMapItem(Items[J]);
+              if MapItem.MapName = MapName then
+                begin
+                UMap := True;
+                Exit;
+                end;
+              end;
+        Exit;
+        end;
+      end;
+  end;
+end;
+
+function TImageObjList.PtInObject(X : integer; Y: integer; var Obj: TObject;
+         var IX, IY: integer): boolean;
+var
+  I, LimX, LimY: integer;
+  LIY: integer;
+  Item: TObject;   
+begin
+Result := False;
+for I := 0 to Count-1 do
+  begin
+  Item := TImageObj(Items[I]); 
+  if Item is TImageObj then
+    with TImageObj(Item) do
+      begin
+      IX := X-DrawX;    {these are actual image, box if any is outside}
+      LIY := Y - DrawYY;
+      if HasBlueBox then begin LimX := ImageWidth-2; Limy := ImageHeight-2; end
+        else begin LimX := ImageWidth; Limy := ImageHeight; end;
+      if (IX >= 0) and (IX < LimX) and (LIY >= 0) and (LIY < LimY) then
+        begin
+        IY := LIY;
+        Result := True;
+        Obj := Item;  
+        Exit;
+        end;
+      end;
+  end;
+end;
+
+{----------------ThtmlForm.Create}
+constructor ThtmlForm.Create(AMasterList: TSectionList; L : TAttributeList);
+var
+  I: integer;
+begin
+inherited Create;
+MasterList := AMasterList;
+AMasterList.htmlFormList.Add(Self);
+Method := 'Get';
+if Assigned(L) then
+  for I := 0 to L.Count-1 do
+    with TAttribute(L[I]) do
+      case Which of
+        MethodSy: Method := Name;
+        ActionSy: Action := Name;
+        TargetSy: Target := Name;
+        EncTypeSy: EncType := Name;
+        end;
+ControlList := TFreeList.Create;
+end;
+
+destructor ThtmlForm.Destroy;
+begin
+ControlList.Free;
+inherited Destroy;
+end;
+
+procedure ThtmlForm.InsertControl(Ctrl: TFormControlObj);
+begin
+ControlList.Add(Ctrl);
+if not (Ctrl is THiddenFormControlObj) then Inc(NonHiddenCount);
+end;
+
+procedure ThtmlForm.DoRadios(Radio: TRadioButtonFormControlObj);
+var
+  S: string;
+  Ctrl: TFormControlObj;
+  I: integer;
+begin
+if Radio.Name <>'' then
+  begin
+  S := Radio.Name;
+  for I := 0 to ControlList.Count-1 do
+    begin
+    Ctrl := TFormControlObj(ControlList.Items[I]);
+    if  (Ctrl is TRadioButtonFormControlObj) and (Ctrl <> Radio) then
+      if CompareText(Ctrl.Name, S) = 0 then
+        TRadioButtonFormControlObj(Ctrl).RButton.Checked := False;
+    end;
+  end;
+end;
+
+procedure ThtmlForm.ResetControls;
+var
+  I: integer;
+begin
+for I := 0 to ControlList.Count-1 do
+  TFormControlObj(ControlList.Items[I]).ResetToValue;
+end;
+
+procedure ThtmlForm.ControlKeyDown(Sender: TObject; var Key: Word;
+              Shift: TShiftState);
+begin
+if (Sender is TEdit) then
+  if (Key = VK_RETURN) then   
+    SubmitTheForm('');
+end;
+
+procedure ThtmlForm.SubmitTheForm(const ButtonSubmission: string);
+var
+  I, J: integer;
+  SL: TStringList;
+  S: string;
+begin
+if Assigned(MasterList.SubmitForm) then
+  begin
+  SL := TStringList.Create;
+  for I := 0 to ControlList.Count-1 do
+    with  TFormControlObj(ControlList.Items[I]) do
+      begin
+      J := 0;
+      while GetSubmission(J, S) do
+        begin
+        if S <> '' then
+          SL.Add(S);
+        Inc(J);
+        end;
+      end;
+  if ButtonSubmission <> '' then
+    SL.Add(ButtonSubmission);
+  MasterList.SubmitForm(MasterList.TheOwner, Action, Target, EncType, Method, SL);
+  end;
+end;
+
+procedure ThtmlForm.SetSizes(Canvas: TCanvas);
+var
+  I: integer;
+begin
+for I := 0 to ControlList.Count-1 do
+  TFormControlObj(ControlList.Items[I]).SetHeightWidth(Canvas);
+end;
+
+{----------------TFormControlObj.Create}
+constructor TFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList);
+var
+  T: TAttribute;
+begin
+inherited Create;
+Pos := Position;
+MasterList := AMasterList;
+with (MasterList.Parser as ThlParser) do
+  begin
+  if not Assigned(CurrentForm) then   {maybe someone forgot the 
       tag}
+    CurrentForm := ThtmlForm.Create(AMasterList, Nil);
+  AMasterList.FormControlList.Add(Self);
+  MyForm := CurrentForm;
+  end;
+if L.Find(ValueSy, T) then
+  Value := T.Name;
+if L.Find(NameSy, T) then
+  Name := T.Name;
+if L.Find(OnClickSy, T) then  
+  OnClickMessage := T.Name;
+MyForm.InsertControl(Self);
+end;
+
+destructor TFormControlObj.Destroy;
+begin
+if Assigned(FControl) then {hidden controls are Nil}
+  begin
+  TPaintPanel(MasterList.PPanel).RemoveControl(FControl);
+  FControl.Free;
+  end;
+inherited Destroy;
+end;
+
+procedure TFormControlObj.EnterEvent(Sender: TObject);
+{Once form control entered, insure all form controls are tab active}
+var
+  I: integer;
+begin
+MasterList.ControlEnterEvent(Self);
+with MasterList.FormControlList do
+  begin
+  for I := 0 to Count-1 do
+    with  TFormControlObj(Items[I]) do
+      if not ShowIt and Assigned(FControl) then
+        begin
+        FControl.Show;   {makes it tab active}
+        FControl.Left := -4000; {even if it can't be seen}
+        end;
+  end;
+end;
+
+procedure TFormControlObj.ExitEvent(Sender: TObject);
+begin
+MasterList.AdjustFormControls;
+end;
+
+function TFormControlObj.GetControl: TWinControl;
+begin
+Result := FControl;
+end;
+
+procedure TFormControlObj.ResetToValue;
+begin end;
+
+function TFormControlObj.GetSubmission(Index: integer; var S: string): boolean;
+begin
+Result := False;
+end;
+
+procedure TFormControlObj.SetHeightWidth(Canvas: TCanvas);
+begin
+if Assigned(FControl) and not Assigned(FControl.Parent) then
+  FControl.Parent := TPaintPanel(MasterList.PPanel);
+end;
+
+procedure TFormControlObj.FormControlClick(Sender: TObject);  
+begin
+if Assigned(MasterList.ObjectClick) then
+  MasterList.ObjectClick(MasterList.TheOwner, Self, OnClickMessage);
+end;
+
+constructor TImageFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList);
+begin
+inherited Create(AMasterList, Position, L);
+XPos := -1;   {so a button press won't submit image data}
+end;
+
+procedure TImageFormControlObj.ImageClick;
+begin
+FormControlClick(Self);   
+XPos := XTmp; YPos := YTmp;
+MyForm.SubmitTheForm('');
+end;
+
+function TImageFormControlObj.GetSubmission(Index: integer; var S: string): boolean;
+begin
+Result := False;
+if (Index <= 1) and (XPos >= 0) then
+  begin
+  S := '';
+  if Name <> '' then S := Name+'.';
+  if Index = 0 then S := S+'x='+IntToStr(XPos)
+  else
+    begin  {index = 1}
+    S := S+'y='+IntToStr(YPos);
+    XPos := -1;
+    end;
+  Result := True;
+  end;
+end;
+
+{----------------THiddenFormControlObj.GetSubmission}
+function THiddenFormControlObj.GetSubmission(Index: integer; var S: string): boolean;
+begin
+Result := Index = 0;
+if Result then
+  S := Name+'='+Value;
+end;
+
+{----------------TEditFormControlObj.Create}
+constructor TEditFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList; const Typ: string);
+var
+  T: TAttribute;
+  PntPanel: TPaintPanel;
+  I: integer;
+begin
+inherited Create(AMasterList, Position, L);
+EditSize := 20;           
+if L.Find(SizeSy, T) then     
+  begin
+  if T.Value > 0 then EditSize := T.Value
+  else
+    begin    {see if it's comma delimited list}
+    I := IntMin(System.Pos(',', T.Name), System.Pos(' ', T.Name));
+    if I > 1 then EditSize := StrToIntDef(copy(T.Name, 1, I-1), 20);
+    end;
+  end;
+PntPanel := TPaintPanel(AMasterList.PPanel);
+FControl := TEdit.Create(PntPanel);
+with TEdit(FControl) do
+  begin
+  Top := -400;   {so will be invisible until placed}
+  Width := 120;
+  Height := 20;
+  Text := Value;
+  Font.Name := AMasterList.PreFontName;
+  Font.Size := 10;
+  if L.Find(MaxLengthSy, T) then
+    MaxLength := T.Value;
+  if Typ = 'password' then
+    PassWordChar := '*';
+  OnKeyDown := {$IFDEF HL_LAZARUS}@{$ENDIF}MyForm.ControlKeyDown;
+  OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
+  OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
+  OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
+  end;
+end;
+
+procedure TEditFormControlObj.ResetToValue;
+begin
+TEdit(FControl).Text := Value;
+end;
+
+function TEditFormControlObj.GetSubmission(Index: integer; var S: string): boolean;
+begin
+if Index = 0 then
+  begin
+  Result := True;
+  S := Name+'='+TEdit(FControl).Text;
+  end
+else Result := False;
+end;
+
+procedure TEditFormControlObj.SetHeightWidth(Canvas: TCanvas);
+begin
+if not Assigned(FControl.Parent) then
+  FControl.Parent := TPaintPanel(MasterList.PPanel);  
+with TEdit(FControl) do
+  begin
+  Canvas.Font := Font;
+  Width := Canvas.TextWidth('A')*EditSize+5;
+  end;
+end;
+
+{----------------TButtonFormControlObj.Create}
+constructor TButtonFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList; const Typ: string);
+var
+  PntPanel: TPaintPanel;
+begin
+inherited Create(AMasterList, Position, L);
+if Typ = 'submit' then
+  begin
+  Which := Submit;
+  if Value = '' then
+    Value := 'Submit';
+  end
+else if Typ = 'reset' then
+  begin
+  Which := ResetB;
+  if Value = '' then
+    Value := 'Reset';
+  end
+else
+  begin
+  Which := Button;
+  if Value = '' then
+    Value := 'Button';
+  end;
+PntPanel := TPaintPanel(AMasterList.PPanel);
+FControl := TButton.Create(PntPanel);
+with TButton(FControl) do
+  begin
+  Top := -400;   {so will be invisible until placed}
+  OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}ButtonClick;
+  Caption := Value;
+  OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
+  OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
+  end;
+end;
+
+procedure TButtonFormControlObj.ButtonClick(Sender: TObject);
+var
+  S: string;
+begin
+FormControlClick(Self);   
+if Which = ResetB then
+  MyForm.ResetControls
+else if Which = Submit then
+  if Name = '' then
+    MyForm.SubmitTheForm('')
+  else
+    begin
+    S := Name;
+    MyForm.SubmitTheForm(S+'='+Value);
+    end;       
+end;
+
+procedure TButtonFormControlObj.SetHeightWidth(Canvas: TCanvas);
+begin
+if Assigned(FControl) and not Assigned(FControl.Parent) then
+  FControl.Parent := TPaintPanel(MasterList.PPanel);
+with TButton(FControl) do
+  begin
+  Canvas.Font := Font;
+  Height := Canvas.TextHeight('A')+8;
+  Width := Canvas.TextWidth(Caption)+20;
+  end;
+end;
+
+{----------------TCheckBoxFormControlObj.Create}
+constructor TCheckBoxFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList);
+var
+  T: TAttribute;
+  PntPanel: TPaintPanel;
+begin
+inherited Create(AMasterList, Position, L);
+if Value = '' then Value := 'on';
+BaseLine := True;  {sits on text baseline}
+if L.Find(CheckedSy, T) then IsChecked := True;
+PntPanel := TPaintPanel(AMasterList.PPanel);
+FControl := TCheckBox.Create(PntPanel);
+with TCheckBox(FControl) do
+  begin
+  Top := -400;   {so will be invisible until placed}
+  Width := 13;
+  Height := 13;
+  Checked := IsChecked;
+  OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}FormControlClick;
+  OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
+  OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
+  end;
+end;
+
+procedure TCheckBoxFormControlObj.ResetToValue;
+begin
+TCheckBox(FControl).Checked := IsChecked;
+end;
+
+function TCheckBoxFormControlObj.GetSubmission(Index: integer; var S: string): boolean;
+begin
+if (Index = 0) and TCheckBox(FControl).Checked then
+  begin
+  Result := True;
+  S := Name+'='+Value;
+  end
+else Result := False;
+end;
+
+constructor TRadioButtonFormControlObj.Create(AMasterList: TSectionList;
+            Position: integer; L: TAttributeList; ACell: TCell);
+var
+  T: TAttribute;
+  PntPanel: TPaintPanel;
+begin
+inherited Create(AMasterList, Position, L);
+MyCell := ACell;
+PntPanel := TPaintPanel(AMasterList.PPanel);
+FControl := TPanel.Create(PntPanel);
+BaseLine := True;  {sits on text baseline}
+if L.Find(CheckedSy, T) then IsChecked := True;
+{Use a TPanel to isolate RadioButton action}
+with TPanel(FControl) do
+  begin
+  Top := -400;   {so will be invisible until placed}
+  Width := 13;
+  Height := 14;
+  BevelOuter := bvNone;
+  BevelInner := bvNone;
+  ParentColor := False;
+  end;
+RButton := TRadioButton.Create(FControl);
+RButton.Checked := IsChecked;
+FControl.InsertControl(RButton);
+RButton.OnClick := {$IFDEF HL_LAZARUS}@{$ENDIF}RadioClick;
+RButton.OnEnter := {$IFDEF HL_LAZARUS}@{$ENDIF}EnterEvent;
+RButton.OnExit := {$IFDEF HL_LAZARUS}@{$ENDIF}ExitEvent;
+end;
+
+function TRadioButtonFormControlObj.GetControl: TWinControl;
+begin
+Result := RButton;
+end;
+
+procedure TRadioButtonFormControlObj.RadioClick(Sender: TObject);
+begin
+MyForm.DoRadios(Self);
+FormControlClick(Self);    
+end;
+
+procedure TRadioButtonFormControlObj.ResetToValue;
+begin
+RButton.Checked := IsChecked;
+end;
+
+function TRadioButtonFormControlObj.GetSubmission(Index: integer;
+             var S: string): boolean;
+begin
+if (Index = 0) and RButton.Checked then
+  begin
+  Result := True;
+  S := Name+'='+Value;
+  end
+else Result := False;
+end;
+
+{----------------TCell.Create}
+constructor TCell.Create(Master: TSectionList);
+begin
+inherited Create;
+MasterList := Master;
+IMgr := IndentManager.Create;
+end;
+
+destructor TCell.Destroy;
+begin
+IMgr.Free;
+inherited Destroy;
+end;
+
+{----------------TCell.Add}
+procedure TCell.Add(Item: TSectionBase);
+begin
+if Assigned(Item) then
+  begin
+  inherited Add(Item);
+  if (Item is TSection) then   
+    TSection(Item).Finish;
+  Item.SetParent(MasterList);
+  end;
+end;
+
+{----------------TCell.UpdateFonts}
+procedure TCell.UpdateFonts;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  TSectionBase(Items[I]).UpdateFonts;
+end;
+
+{----------------TCell.FindSectionAtPosition}
+function TCell.FindSectionAtPosition(Pos: integer;
+         var TopPos: integer; var Index: integer): TSectionBase;
+{Find the section which contains the Y Position, Pos.  Return also the position
+ of the top of that section and the index of that section}
+var
+  I: integer;
+  H, Delta: integer;
+begin
+H := 0;
+for I := 0 to Count-1 do
+  begin
+  Delta := TSectionBase(Items[I]).SectionHeight;
+  Inc(H, Delta);
+  if H > Pos then
+    begin
+    TopPos := H-Delta;
+    Result := TSectionBase(Items[I]);
+    Index := I;
+    Exit;
+    end;
+  end;
+Result := Nil;
+end;
+
+{----------------TCell.GetURL}
+function TCell.GetURL(Canvas: TCanvas; X: integer; Y: integer;
+         var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean;
+{Y is absolute}
+var
+  I: integer;
+  H: integer;
+begin
+Result := False;
+FormControl := Nil;
+UrlTarg := Nil;
+H := 0;
+for I := 0 to Count-1 do
+  with TSectionBase(Items[I]) do
+    begin
+    if (Y >= H) and (Y < H+DrawHeight) then
+        begin
+        Result := GetURL(Canvas, X, Y-H, UrlTarg, FormControl);
+        if Result then
+          Exit;
+        end;
+    Inc(H, SectionHeight);
+    end;
+end;
+
+{----------------TCell.PtInObject}
+function TCell.PtInObject(X: integer; Y: integer;  var Obj: TObject;  
+              var IX, IY: integer): boolean;
+{Y is absolute}
+var
+  I: integer;
+  H: integer;
+begin
+Result := False;
+Obj := Nil;
+H := 0;
+for I := 0 to Count-1 do
+  with TSectionBase(Items[I]) do
+    begin
+    if (Y >= H) and (Y < H+DrawHeight) then
+        begin
+        Result := PtInObject(X, Y-H, Obj, IX, IY);
+        if Result then
+          Exit;
+        end;
+    Inc(H, SectionHeight);
+    end;
+end;
+
+{----------------TCell.FindCursor}
+function TCell.FindCursor(Canvas: TCanvas; X: Integer; Y: integer;
+                var XR: integer; var YR: integer; var Ht: integer;
+                var SCell: TObject; var Intext: boolean): integer;
+{Y, YR is absolute}
+var
+  Dummy: integer;
+  H: integer;
+  S: TSectionBase;
+begin
+S := FindSectionAtPosition(Y, H, Dummy);
+if Assigned(S) then
+  begin
+  Result := S.FindCursor(Canvas, X, Y-H, XR, YR, Ht, SCell, InText);
+  Inc(YR, H);
+  end
+else Result := -1;
+if (Result >= 0) and not Assigned(SCell) then SCell := Self;
+end;
+
+{----------------TCell.FindString}
+function TCell.FindString(From: integer; PC: PChar; MatchCase: boolean): integer;
+var
+  I: integer;
+begin
+Result := -1;
+for I := 0 to Count-1 do
+  begin
+  Result := TSectionBase(Items[I]).FindString(From, PC, MatchCase);
+  if Result >= 0 then
+    Break;
+  end;
+end;
+
+{----------------TCell.FindSourcePos}
+function TCell.FindSourcePos(DocPos: integer): integer;
+var
+  I: integer;
+begin
+Result := -1;
+for I := 0 to Count-1 do
+  begin
+  Result := TSectionBase(Items[I]).FindSourcePos(DocPos);
+  if Result >= 0 then
+    Break;
+  end;
+end;
+
+{----------------TCell.FindDocPos}
+function TCell.FindDocPos(SourcePos: integer; Prev: boolean): integer;  
+var
+  I: integer;
+begin
+Result := -1;
+if not Prev then
+  for I := 0 to Count-1 do
+    begin
+    Result := TSectionBase(Items[I]).FindDocPos(SourcePos, Prev);
+    if Result >= 0 then
+      Break;
+    end
+else  //Prev, iterate backwards
+  for I := Count-1 downto 0 do
+    begin
+    Result := TSectionBase(Items[I]).FindDocPos(SourcePos, Prev);
+    if Result >= 0 then
+      Break;
+    end
+end;
+
+{----------------TCell.CursorToXY}
+function TCell.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
+             var Y: integer): boolean;
+var
+  I: integer;
+begin
+Result := False;
+for I := 0 to Count-1 do
+  begin
+  Result := TSectionBase(Items[I]).CursorToXY(Canvas, Cursor, X, Y);
+  if Result then Break;
+  end;
+end;
+
+{----------------TCell.GetChAtPos}   
+function TCell.GetChAtPos(Pos: integer; var Ch: char; var Obj: TObject): boolean;
+var
+  I: integer;
+begin
+Result := False;
+if (Pos >= StartCurs) and (Pos <= StartCurs+Len) then
+  for I := 0 to Count-1 do
+    begin
+    Result := TSectionBase(Items[I]).GetChAtPos(Pos, Ch, Obj);
+    if Result then Break;
+    end;
+end;
+
+{----------------TCell.CopyToClipboard}
+procedure TCell.CopyToClipboard;
+var
+  I: integer;                    
+  SLE, SLB: integer;
+begin
+if not Assigned(MasterList) then Exit;  {dummy cell}
+SLB := MasterList.SelB;
+SLE := MasterList.SelE;
+if SLE <= SLB then Exit;   {nothing to do}
+
+for I := 0 to Count-1 do
+  with TSectionBase(Items[I]) do
+    begin
+    if (SLB >= StartCurs + Len) then Continue;
+    if (SLE <= StartCurs) then Break;
+    CopyToClipboard;
+    end;
+end;
+
+{----------------TCell.DoLogic}
+function TCell.DoLogic(Canvas: TCanvas; Y: integer; Width: integer;
+                 var ScrollWidth: integer; var Curs: integer;
+                 StartY,  StartCount: integer): integer;
+{Do the entire layout of the cell or document.  Return the total document
+ pixel height}
+var
+  I, Sw, TheCount: integer;
+  H, IB: integer;
+begin
+  IMgr.Clear;
+  IMgr.Reset(0, Width);
+  IMgr.Width := Width;
+  YValue := Y;
+  StartCurs := Curs;
+  H := StartY;
+  TheCount := Count;
+  I := StartCount;
+  while I < TheCount do
+    begin
+    try
+      H := TSectionBase(Items[I]).DrawLogic(Canvas, Y+H, IMgr, Sw, Curs)+ H;
+      ScrollWidth := IntMax(ScrollWidth, Sw);
+      Inc(I);
+    except
+      on E:EProcessError do
+        begin
+        MessageDlg(E.Message, mtError, [mbOK], 0);
+        TSectionBase(Items[I]).Free;
+        Delete(I);
+        Dec(TheCount);
+        end;
+      end;
+    end;
+  Len := Curs - StartCurs;
+  Result := H;
+  IB := IMgr.ImageBottom - YValue;   {check for image overhang}
+  if IB > Result then
+    Result := IB;
+ end;
+
+{----------------TCell.MinMaxWidth}
+procedure TCell.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer);
+{Find the Width the cell would take if no wordwrap, Max, and the width if wrapped
+ at largest word, Min}
+var
+  I, Mn, Mx: integer;
+begin
+Max := 0; Min := 0;
+for I := 0 to Count-1 do
+  begin
+  TSectionBase(Items[I]).MinMaxWidth(Canvas, Mn, Mx);
+  Max := IntMax(Max, Mx);
+  Min := IntMax(Min, Mn);
+  end;
+end;
+
+{----------------TCell.Draw}
+function TCell.Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer;
+                            Y: integer): integer;
+{draw the document or cell.  Note: individual sections not in ARect don't bother
+ drawing}
+var
+  I: integer;
+  H: integer;
+begin
+  IMgr.Reset(X, X+IMgr.Width);
+  IMgr.ClipWidth := ClipWidth;
+  H := Y;
+  for I := 0 to Count-1 do
+    begin
+    H := TSectionBase(Items[I]).Draw(Canvas, ARect, IMgr, X, H);
+    end;
+  Result := H;
+end;
+
+{----------------TSectionList}
+constructor TSectionList.Create(Owner, APaintPanel: TWinControl);
+begin
+inherited Create(Self);
+TheOwner := Owner;
+PPanel := APaintPanel;
+htmlFormList := TFreeList.Create;
+AGifList := TList.Create;
+MapList := TFreeList.Create;
+FormControlList := TList.Create;
+MissingImages := TStringList.Create;   
+MissingImages.Sorted := False;
+LinkList := TList.Create;
+UnLine := [fsUnderline];
+end;
+
+destructor TSectionList.Destroy;
+begin
+Clear;
+htmlFormList.Free;
+MapList.Free;
+AGifList.Free;
+Timer.Free;
+FormControlList.Free;
+MissingImages.Free;
+LinkList.Free;
+inherited Destroy;
+end;
+
+function TSectionList.GetURL(Canvas: TCanvas; X: integer; Y: integer;
+             var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean;
+var
+  OldLink: TFontObj;
+  OldImage: TImageObj;
+begin
+OldLink := ActiveLink;
+OldImage := ActiveImage;
+ActiveLink := Nil;
+ActiveImage := Nil;
+Result := inherited GetUrl(Canvas, X, Y, UrlTarg, FormControl);
+if LinksActive and (ActiveLink <> OldLink) then
+  begin
+  if OldLink <> Nil then OldLink.Hover := False;
+  if ActiveLink <> Nil then ActiveLink.Hover := True;
+  PPanel.Invalidate;
+  end;
+if (ActiveImage <> OldImage) then
+  begin        
+  if OldImage <> Nil then OldImage.Hover := False;
+  if ActiveImage <> Nil then ActiveImage.Hover := True;
+  PPanel.Invalidate;
+  end;
+end;
+
+procedure TSectionList.CancelActives;
+begin
+if Assigned(ActiveLink) or Assigned(ActiveImage) then
+  PPanel.Invalidate;
+if Assigned(ActiveLink) then
+  begin
+  ActiveLink.Hover := False;
+  ActiveLink := Nil;
+  end;
+if Assigned(ActiveImage) then
+  begin
+  ActiveImage.Hover := False;
+  ActiveImage := Nil;
+  end;
+end;
+
+procedure TSectionList.CheckGIFList(Sender: TObject);
+var
+  I: integer;
+begin
+for I := 0 to AGifList.Count-1 do
+    with TGifImage(AGifList.Items[I]) do
+      if ShowIt then
+        begin
+        CheckTime(PPanel);
+        end;
+Timer.Interval := 50;
+end;
+
+procedure TSectionList.SetYOffset(Y: integer);
+var
+  I, J: integer;
+begin
+if Y <> YOff then
+  begin
+  YOff := Y;
+  YOffChange := True;
+  {After next Draw, hide all formcontrols that aren't to be shown}
+  for I := 0 to htmlFormList.Count-1 do
+    with ThtmlForm(htmlFormList.Items[I]) do
+      for J := 0 to ControlList.Count-1 do
+        with  TFormControlObj(ControlList.Items[J]) do
+          ShowIt := False;
+  end;
+end;
+
+procedure TSectionList.Clear;
+begin
+BackgroundBitmap := Nil;
+BackgroundMask := Nil;  
+if BitmapLoaded and (BitmapName <> '') then
+  BitmapList.DecUsage(BitmapName);
+BitmapName := '';
+BitmapLoaded := False;
+htmlFormList.Clear;
+if Assigned(FormControlList) then
+  FormControlList.Clear;
+AGifList.Clear;
+Timer.Free;
+Timer := Nil;
+SelB := 0;
+SelE := 0;
+MapList.Clear;
+MissingImages.Clear;
+if Assigned(LinkList) then
+  LinkList.Clear;
+ActiveLink := Nil;   
+ActiveImage := Nil;
+inherited Clear;
+end;
+
+{----------------TSectionList.GetSelLength:}
+function TSectionList.GetSelLength: integer;
+var
+  I: integer;
+begin
+Result := 0;
+if SelE <= SelB then Exit;   {nothing to do}
+CB := SelTextCount.Create;
+try
+  for I := 0 to Count-1 do
+    with TSectionBase(Items[I]) do
+      begin
+      if (SelB >= StartCurs + Len) then Continue;
+      if (SelE <= StartCurs) then Break;
+      CopyToClipboard;
+      end;
+  Result := CB.Terminate;
+finally
+  CB.Free;
+  end;
+end;
+
+{----------------TSectionList.GetSelTextBuf}
+function TSectionList.GetSelTextBuf(Buffer: PChar; BufSize: integer): integer;
+var
+  I: integer;
+begin
+if BufSize >= 1 then
+  begin
+  Buffer[0] := #0;
+  Result := 1;
+  end
+else Result := 0;
+if SelE <= SelB then Exit;   {nothing to do}
+CB := SelTextBuf.Create(Buffer, BufSize);  
+try
+  for I := 0 to Count-1 do
+    with TSectionBase(Items[I]) do
+      begin
+      if (SelB >= StartCurs + Len) then Continue;
+      if (SelE <= StartCurs) then Break;
+      CopyToClipboard;
+      end;
+  Result := CB.Terminate;
+finally
+  CB.Free;
+  end;
+end;
+
+{----------------TSectionList.DoLogic}
+function TSectionList.DoLogic(Canvas: TCanvas; Y: integer; Width: integer;
+              var ScrollWidth: integer; var Curs: integer;
+                 StartY,  StartCount: integer): integer;
+var
+  I: integer;
+begin
+if Assigned(Timer) then Timer.Enabled := False;
+for I := 0 to htmlFormList.Count-1 do
+  ThtmlForm(htmlFormList.Items[I]).SetSizes(Canvas);
+
+Result := inherited DoLogic(Canvas, Y, Width, ScrollWidth, Curs, StartY, StartCount);
+
+for I := 0 to AGifList.Count-1 do
+  with TGifImage(AGifList.Items[I]) do
+    begin
+    CurrentFrame := 1;   {required for dtDoNothing and background}
+    Animate := False;    {starts iteration count from 1}
+    Animate := True;
+    end;
+if not Assigned(Timer) then
+  begin
+  Timer := TTimer.Create(TheOwner as ThtmlLite);
+  Timer.Interval := 50;
+  Timer.OnTimer := {$IFDEF HL_LAZARUS}@{$ENDIF}CheckGIFList;
+  end;
+if Assigned(Timer) then Timer.Enabled := AGifList.Count >= 1;
+AdjustFormControls;
+end;
+
+procedure TSectionList.AdjustFormControls;
+var
+  I: integer;
+
+  function ActiveInList: boolean; {see if active control is a form control}
+  var
+    Control: TWinControl;
+    I: integer;
+  begin
+  with FormControlList do
+    begin
+    Result := False;
+    Control := Screen.ActiveControl;
+    for I := 0 to Count-1 do
+      with  TFormControlObj(Items[I]) do
+        if FControl = Control then
+          begin
+          Result := True;
+          Break;
+          end;
+    end;
+  end;
+
+begin
+if (FormControlList.Count = 0) then Exit;
+with FormControlList do
+  if not ActiveInList then
+    begin  {if none of the formcontrols are active, turn off tabs for those off screen}
+    for I := 0 to Count-1 do
+      with  TFormControlObj(Items[I]) do
+        if not ShowIt and Assigned(FControl) then
+          FControl.Hide;   {hides and turns off tabs}
+    end
+  else
+    for I := 0 to Count-1 do
+      with  TFormControlObj(Items[I]) do
+        if not ShowIt and Assigned(FControl) then
+          begin
+          FControl.Show;   {turns on tabs}
+          FControl.Left := -4000;  {but it still can't be seen}
+          end;
+end;
+
+{----------------TSectionList.Draw}
+function TSectionList.Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer;
+                          Y:integer): integer;
+var
+  OldPal: HPalette;
+  I: integer;
+begin
+PageBottom := ARect.Bottom + YOff;
+if Assigned(Timer) then Timer.Enabled := False;
+for I := 0 to AGifList.Count-1 do
+  with TGifImage(AGifList.Items[I]) do
+    begin
+    ShowIt := False;
+    end;
+OldPal := SelectPalette(Canvas.Handle, ThePalette, True);
+RealizePalette(Canvas.Handle);
+try
+  Result := inherited Draw(Canvas, ARect, ClipWidth, X, Y);
+finally
+  SelectPalette(Canvas.Handle, OldPal, True);
+  end;
+if YOffChange then
+  begin
+  AdjustFormControls;
+  YOffChange := False;
+  end;
+if Assigned(Timer) then Timer.Enabled := AGifList.Count >= 1;
+end;
+
+procedure TSectionList.SetFonts(const Name, PreName: String; ASize: integer;
+          AColor, AHotSpot, AVisitedColor, AActiveColor, ABackground: TColor;
+          LnksActive: boolean);
+begin
+FontName := Name;
+PreFontName := PreName;
+FontSize := ASize;
+FontColor := AColor;
+HotSpotColor := AHotSpot;
+LinkVisitedColor := AVisitedColor;
+LinkActiveColor := AActiveColor;
+LinksActive := LnksActive;
+SetBackground(ABackground);
+UpdateFonts;
+end;
+
+procedure TSectionList.SetBackground(ABackground: TColor);
+begin
+Background := ABackground;
+if Assigned(OnBackGroundChange) then
+  OnBackgroundChange(Self);
+end;
+
+procedure TSectionList.SetBackgroundBitmap(Name: String);
+begin
+BackgroundBitmap := Nil;
+BitmapName := Name;
+BitmapLoaded := False;
+end;
+
+{----------------TSectionList.InsertImage}
+procedure TSectionList.InsertImage(const Src: string; Stream: TMemoryStream;
+               var Reformat: boolean); 
+var
+  UName: string;
+  I, J: integer;
+  Pair: TBitmapItem;
+  NonAnimated, Rformat: boolean;
+  Image: TPersistent;
+  AMask: TBitmap;
+  Tr, Transparent: Transparency;
+  Obj: TObject;
+  Tmp: TGifImage;
+begin
+Image := Nil;  AMask := Nil;
+Reformat := False;
+UName := Trim(Uppercase(Src));
+I := BitmapList.IndexOf(UName);  {first see if the bitmap is already loaded}
+J := MissingImages.IndexOf(UName); {see if it's in missing image list}
+if (I = -1) and (J >= 0) then
+  begin
+  Transparent := NotTransp;    
+  if Assigned(Stream) and (Stream.Memory <> Nil) and (Stream.Size >= 1) then
+    begin
+    NonAnimated := True;
+    if KindOfImage(Stream.Memory) in [GIF, Gif89] then
+      Image := CreateAGifFromStream(NonAnimated, Stream);
+    if Assigned(Image) then
+      begin
+      if NonAnimated then
+        begin     {else already have animated GIF}
+        Tmp := TGifImage(Image);
+        Image := TBitmap.Create;
+        Image.Assign(Tmp.MaskedBitmap);
+        if Tmp.IsTransparent then
+          begin
+          AMask := TBitmap.Create;
+          AMask.Assign(Tmp.Mask);
+          Transparent := TGif;
+          end;
+        Tmp.Free;
+        end;
+      end
+    else
+      Image := GetImageAndMaskFromStream(Stream, Transparent, AMask);
+    end;
+  if Assigned(Image) then  {put in Cache}
+    try
+      if Assigned(AMask) then Tr := Transparent
+        else Tr := NotTransp;
+      Pair := TBitmapItem.Create(Image, AMask, Tr);
+      try
+        BitmapList.AddObject(UName, Pair);  {put new bitmap in list}
+        BitmapList.DecUsage(UName);    {this does not count as being used yet}
+      except
+        Pair.Mask := Nil;
+        Pair.MImage:= Nil;
+        Pair.Free;
+      end;
+    except  {accept inability to create}
+    end;
+  end;
+if (I >= 0) or Assigned(Image) then  {a valid image in the Cache}
+  begin
+  while J >= 0 do
+    begin
+    Obj := MissingImages.Objects[J];
+    if (Obj = Self) then
+      BitmapLoaded := False  {the background image, set to load}
+    else if (Obj is TImageObj) then
+      begin
+      TImageObj(Obj).InsertImage(UName, Rformat);
+      Reformat := Reformat or Rformat;
+      end;
+    MissingImages.Delete(J);
+    J := MissingImages.IndexOf(UName);
+    end;
+  end;
+end;
+
+{----------------TSectionList.GetTheBitmap}
+function TSectionList.GetTheBitmap(const BMName: String; var Transparent: Transparency;
+         var AMask: TBitmap; var FromCache, Delay: boolean): TPersistent;
+{Note: bitmaps and Mask returned by this routine are on "loan".  Do not destroy
+ them}
+{Transparent may be set to NotTransp or LLCorner on entry but may discover it's
+ TGif here}
+
+{$ifdef ShareWare}
+const
+  OneTime: boolean = False;
+{$endif}
+
+var
+  UName: string;
+  Ext: string[10];
+  I: integer;
+  Pair: TBitmapItem;
+  Tr: Transparency;
+  NonAnimated: boolean;
+  Stream: TMemoryStream;
+  Tmp: TGifImage;
+
+begin
+{$ifdef ShareWare}
+{$Include DemoVers.inc}
+{$endif}
+AMask := Nil;
+Delay := False;
+FromCache := False;
+if BMName <> '' then
+  begin
+  UName := Trim(Uppercase(BMName));
+  I := BitmapList.IndexOf(UName);  {first see if the bitmap is already loaded}
+  if I > -1 then
+    begin         {yes, handle the case where the image is already loaded}
+    Result := BitmapList.GetImage(I);
+    FromCache := True;
+    if Result is TBitmap then
+      with  BitmapList.Objects[I] as TBitmapItem do
+        begin
+        if Transp = TGif then
+          Transparent := TGif   {it's a transparent GIF}
+        else if Transp = Tpng then
+          Transparent := TPng
+        else if Transparent = LLCorner then
+          begin
+          if not Assigned (Mask) then  {1st bitmap may not have been marked transp}
+            Mask := GetImageMask(TBitmap(MImage), False, 0);
+          if Assigned(Mask) then Transp := LLCorner;
+          end;
+        AMask := Mask;
+        end;
+    Exit;
+    end;
+
+  {The image is not loaded yet, need to get it}
+  Result := Nil;
+  if Assigned(GetImage) then
+    begin    {the OnImageRequest}
+    Stream := Nil;
+    GetImage(TheOwner, BMName, Stream);
+    if Stream = WaitStream then
+      Delay := True
+    else if Assigned(Stream) and (Stream.Memory <> Nil) and (Stream.Size >= 1) then
+      begin
+      NonAnimated := True;
+      if KindOfImage(Stream.Memory) in [GIF, Gif89] then
+        Result := CreateAGifFromStream(NonAnimated, Stream);
+      if Assigned(Result) then
+        begin
+        if NonAnimated then
+          begin     {else already have animated GIF}
+          Tmp := TGifImage(Result);
+          Result := TBitmap.Create;
+          Result.Assign(Tmp.MaskedBitmap);
+          if Tmp.IsTransparent then
+            begin
+            AMask := TBitmap.Create;
+            AMask.Assign(Tmp.Mask);
+            Transparent := TGif;
+            end
+          else if Transparent = LLCorner then
+            AMask := GetImageMask(TBitmap(Result), False, 0);
+          Tmp.Free;
+          end;
+        end
+      else
+        Result := GetImageAndMaskFromStream(Stream, Transparent, AMask);
+      end;
+    end
+  else
+    begin   {look for the image file}
+    Ext := ExtractFileExt(BMName);
+    NonAnimated := True;
+    if (CompareText(Ext, '.gif')=0) then   {remove .gfr check}  
+      Result := CreateAGif(BMName, NonAnimated);
+      if Assigned(Result) then
+        begin
+        if NonAnimated then
+          begin     {else already have animated GIF}
+          Tmp := TGifImage(Result);
+          Result := TBitmap.Create;
+          Result.Assign(Tmp.MaskedBitmap);
+          if Tmp.IsTransparent then
+            begin
+            AMask := TBitmap.Create;
+            AMask.Assign(Tmp.Mask);
+            Transparent := TGif;
+            end
+          else if Transparent = LLCorner then
+            AMask := GetImageMask(TBitmap(Result), False, 0);
+          Tmp.Free;
+          end;
+        end
+      else
+        Result := GetImageAndMaskFromFile(BMName, Transparent, AMask);
+    end;
+  if Assigned(Result) then  {put in Image List for use later also}
+    try
+      if Assigned(AMask) then Tr := Transparent
+        else Tr := NotTransp;
+      Pair := TBitmapItem.Create(Result, AMask, Tr);
+      try
+        BitmapList.AddObject(UName, Pair);  {put new bitmap in list}
+      except
+        Pair.Mask := Nil;
+        Pair.MImage:= Nil;
+        Pair.Free;
+      end;
+    except  {accept inability to create}
+    end;
+  end
+else Result := Nil;
+end;
+
+function TSectionList.FindPositionByIndex(Index: integer): integer;
+{given a section index, find the vertical pixel distance to that section}
+var
+  I: integer;
+begin
+Result := 0;
+for I := 0 to IntMin(Index-1, Count-2) do
+  Result := TSectionBase(Items[I]).SectionHeight+ Result;
+end;
+
+function TSectionList.GetBackgroundBitmap: TBitmap;
+var
+  Mask: TBitmap;   
+  Dummy1: Transparency;
+  TmpResult: TPersistent;
+  FromCache, Delay: boolean;
+  Rslt: string;
+begin
+if ShowImages and not BitmapLoaded and (BitmapName <> '') then
+  begin
+  if not Assigned(BackgroundBitmap) then
+    begin
+    Dummy1 := NotTransp;
+    if not Assigned(GetImage) then
+      BitmapName := (TheOwner as ThtmlLite).HTMLExpandFilename(BitmapName)
+    else if Assigned(ExpandName) then
+      begin
+      ExpandName(TheOwner, BitmapName, Rslt);
+      BitmapName := Rslt;
+      end;
+    TmpResult := GetTheBitmap(BitmapName, Dummy1, Mask, FromCache, Delay); {might be Nil}
+    if TmpResult is TBitmap then
+      begin
+      BackgroundBitmap := TBitmap(TmpResult);
+      BackgroundMask := Mask;   
+      end
+    else
+      begin
+      BackgroundBitmap := Nil;
+      if Delay then
+        MissingImages.AddObject(BitmapName, Self);
+      end;
+    BitmapLoaded := True;   
+    end;
+  end;
+Result := BackgroundBitmap;
+end;
+
+{----------------TCellObj.Create}
+constructor TCellObj.Create(Master: TSectionList; AVAlign: AlignmentType;
+             Attr: TAttributeList);
+var
+  I: integer;    
+begin
+inherited Create;
+Cell := TCell.Create(Master);
+ColSpan := 1;
+RowSpan := 1;
+VAlign := AVAlign;
+if Assigned(Attr) then
+  for I := 0 to Attr.Count-1 do
+    with TAttribute(Attr[I]) do
+      case Which of
+        ColSpanSy:
+          if Value > 1 then ColSpan := Value;
+        RowSpanSy:
+          if Value > 1 then RowSpan := Value;
+        WidthSy:
+          if Pos('%', Name) > 0 then
+            begin
+            if (Value > 0) and (Value <= 100) then
+              begin
+              WidthAttr := Value*10;    
+              AsPercent := True;
+              end;
+            end
+          else if (Value > 0) then   
+            WidthAttr := Value;
+        HeightSy: SpecHt := Value;   
+        BGColorSy:
+          Cell.BkGnd := GetColor(Name, Cell.BkColor);
+        end;
+end;
+
+destructor TCellObj.Destroy;
+begin
+Cell.Free;
+inherited Destroy;
+end;
+
+procedure TCellObj.UpdateFonts;
+begin
+Cell.UpdateFonts;
+end;
+
+{----------------TSectionBase.Create}
+constructor TSectionBase.Create(AMasterList: TSectionList);
+begin
+inherited Create;
+ParentSectionList := AMasterList;
+end;
+
+procedure TSectionBase.CopyToClipboard;
+begin
+end;
+
+{----------------TSectionBase.DrawLogic}
+function TSectionBase.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer;
+begin
+StartCurs := Curs;
+Result := SectionHeight;
+DrawHeight := SectionHeight;
+MaxWidth := IMgr.Width;
+end;
+
+function TSectionBase.Draw(Canvas: TCanvas; const ARect: TRect;
+     IMgr: IndentManager; X: integer; Y: integer) : integer;
+begin
+YValue := Y;
+Result := Y+SectionHeight;
+end;
+
+function TSectionBase.GetURL(Canvas: TCanvas; X: integer; Y: integer;
+     var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean;
+begin
+Result := False;
+end;
+
+function TSectionBase.PtInObject(X : integer; Y: integer; var Obj: TObject;
+         var IX, IY: integer): boolean;
+begin
+Result := False;
+end;
+
+function TSectionBase.FindCursor(Canvas: TCanvas; X: integer; Y: integer;
+         var XR: integer; var YR: integer; var CaretHt: integer;
+         var SCell: TObject; var Intext: boolean): integer;
+begin
+Result := -1;
+end;
+
+function TSectionBase.FindString(From: integer; PC: PChar; MatchCase: boolean): integer;
+begin
+Result := -1;
+end;
+
+function TSectionBase.FindSourcePos(DocPos: integer): integer;
+begin
+Result := -1;
+end;
+
+function TSectionBase.FindDocPos(SourcePos: integer; Prev: boolean): integer; 
+begin
+Result := -1;
+end;
+
+function TSectionBase.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
+             var Y: integer): boolean;
+begin
+Result := False;
+end;
+
+function TSectionBase.GetChAtPos(Pos: integer; var Ch: char; var Obj: TObject): boolean;
+begin
+Result := False;
+end;
+
+procedure TSectionBase.UpdateFonts;
+begin
+UpdateSpacing;
+end;
+
+procedure TSectionBase.UpdateSpacing;
+begin
+end;
+
+procedure TSectionBase.SetParent(List: TSectionList);
+begin
+ParentSectionList := List;
+UpdateSpacing;
+end;
+
+procedure TSectionBase.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer);
+begin
+Min := 0;  Max := 0;
+end;
+
+{----------------TCellList.DoAttributes}
+procedure TCellList.DoAttributes(Attr: TAttributeList);
+var
+  I: integer;
+begin
+for I := 0 to Attr.Count-1 do
+  with TAttribute(Attr[I]) do
+    if Which = BGColorSy then
+      BkGnd := GetColor(Name, BkColor);
+end;
+
+{----------------TCellList.InitializeRow}     
+procedure TCellList.InitializeRow;
+var
+  I: integer;
+begin
+if BkGnd then
+  for I := 0 to Count-1 do
+    with TCellObj(Items[I]).Cell do     
+      if not BkGnd then
+        begin
+        BkGnd := True;
+        BkColor := Self.BkColor;
+        end;
+end;
+
+{----------------TCellList.UpdateFonts}
+procedure TCellList.UpdateFonts;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  if Assigned(Items[I]) then   
+    TCellObj(Items[I]).UpdateFonts;
+end;
+
+{----------------TCellList.DrawLogic1}
+function TCellList.DrawLogic1(Canvas : TCanvas; const Widths : IntArray; Span,
+           CellPadding, CellSpacing: integer; var More: boolean): integer;
+{Find vertical size of each cell, Row height of this row.  But final Y position
+ is not known at this time.}
+var
+  I, J, Dummy: integer;
+  DummyCurs, H, TmpSize: integer;
+  CellObj: TCellObj;
+begin
+H := 0;
+DummyCurs := 0;
+More := False;
+for I := 0 to Count-1 do
+  begin
+  CellObj := TCellObj(Items[I]);
+  if Assigned(CellObj) then     
+    with CellObj do
+      if ColSpan > 0 then  {skip the dummy cells}
+        begin
+        Wd := 0;
+        for J := I to ColSpan+I-1 do
+          Inc(Wd, Widths[J]);   {accumulate column widths}
+        if Span = RowSpan then
+          begin
+          VSize := Cell.DoLogic(Canvas, 0, Wd-2*CellPadding-CellSpacing,
+                   Dummy, DummyCurs, 0, 0);
+          if VSize > SpecHt-2*CellPadding then TmpSize := VSize
+            else TmpSize := SpecHt-2*CellPadding;
+          if TmpSize > H  then H := TmpSize;
+          end
+        else if RowSpan > Span then More := True;
+        end;
+  end;
+Result := H;
+end;
+
+{----------------TCellList.DrawLogic2}
+procedure TCellList.DrawLogic2(Canvas : TCanvas; Y: integer; CellPadding,
+          CellSpacing: integer; var Curs: integer);
+{Calc Y indents. Set up Y positions of all cells.}
+var
+  I, FullPad, Dummy: integer;
+  Tmp: integer;
+  CellObj: TCellObj;  
+begin
+for I := 0 to Count-1 do
+  begin
+  CellObj := TCellObj(Items[I]);
+  if Assigned(CellObj) then   
+    with CellObj do
+      if Cell.Count > 0 then
+        begin
+        FullPad := 2*CellPadding+CellSpacing;
+        Tmp := Ht - VSize - FullPad;
+        case VAlign of
+          ATop: YIndent := 0;
+          AMiddle: YIndent := Tmp div 2;
+          ABottom: YIndent := Tmp;
+          end;
+        Cell.DoLogic(Canvas, Y+CellPadding+CellSpacing+YIndent, Wd-FullPad,
+                             Dummy, Curs, 0, 0);
+        end;
+  end;
+end;
+
+{----------------TCellList.Draw}
+function TCellList.Draw(Canvas: TCanvas; MasterList: TSectionList; const ARect: TRect;
+     const Widths : IntArray; X: integer; Y, YOffset: integer; CellPadding,
+     CellSpacing : integer; Border: boolean; Rgn: THandle; MyRow: integer) : integer;
+var
+  I, Padding: integer;
+  YO: integer;
+  ARgn: THandle;
+  CellObj: TCellObj;
+  AddOn: integer;   
+begin
+YO := Y - YOffset;
+Result := RowHeight+Y;
+
+if (YO+RowSpanHeight >= ARect.Top) and (YO < ARect.Bottom) then
+  for I := 0 to Count-1 do
+    begin
+    CellObj := TCellObj(Items[I]);
+    if Assigned(CellObj) then     
+      with CellObj do
+        begin
+        if (Cell.Count > 0) then
+          begin
+          Padding := CellPadding+CellSpacing;
+          if Cell.BkGnd then
+            begin
+            Canvas.Brush.Color := Cell.BkColor or $2000000;
+            Canvas.FillRect(Rect(X+CellSpacing, IntMax(YO+CellSpacing, TopLim),
+                     X+Wd, IntMin(YO+Ht, BotLim)));  
+            end;
+          Cell.Draw(Canvas, ARect, Wd-Padding-CellPadding, X+Padding,
+                        Y+Padding+YIndent);
+          if Border then
+            begin
+            RaisedRect(Cell.MasterList, Canvas, X+CellSpacing-1, YO+CellSpacing-1,
+                                          X+Wd, YO+Ht, False);
+            end;
+
+          if Rgn <> 0 then
+            begin
+            if Border then
+              AddOn := 1
+            else
+              AddOn := 0;
+            ARgn := CreateRectRgn(X+CellSpacing-AddOn, IntMax(YO+CellSpacing-AddOn, TopLim),
+                                  X+Wd+AddOn, IntMin(YO+Ht+AddOn, BotLim));  
+            CombineRgn(Rgn, Rgn, ARgn, RGN_DIFF);
+            DeleteObject(ARgn);
+            end;
+          end;
+        end;
+    X := X + Widths[I];  
+    end;
+end;
+
+{----------------ThtmlTable.Create}
+constructor ThtmlTable.Create(Master: TSectionList;Attr: TAttributeList;
+            AJustify: JustifyType; ACell: TCell; ALevel: integer);
+var
+  I: integer;
+begin
+inherited Create(Master);
+MyCell := ACell;
+Level := ALevel;
+Rows := TFreeList.Create;
+Caption := TCellObj.Create(Master, ATop, Nil);
+TopCaption := True;
+Justify := AJustify;
+CellPadding := 1;
+CellSpacing := 2;    
+HSpace := ImageSpace;
+for I := 0 to Attr.Count-1 do
+  with TAttribute(Attr[I]) do
+    case Which of
+      BorderSy:
+        Border := Value > 0;   {Border=0 is no border}
+      AlignSy:
+        if CompareText(Name, 'CENTER') = 0 then Justify := Centered
+        else if CompareText(Name, 'LEFT') = 0 then
+          begin
+          Justify := Left;
+          Float := True;
+          end
+        else if CompareText(Name, 'RIGHT') = 0 then
+          begin
+          Justify := Right;
+          Float := True;
+          end;
+      CellSpacingSy:
+        if Value >= 0 then CellSpacing := IntMin(Value, 40);
+      CellPaddingSy:
+        if Value >= 0 then CellPadding := IntMin(Value, 50);
+      WidthSy:
+        if Pos('%', Name) > 0 then
+          begin
+          if (Value > 0) and (Value <= 100) then WidthAttr := Value*10;
+          AsPercent := True;
+          end
+        else WidthAttr := Value;
+      HeightSy:                      
+        if (Pos('%', Name) > 0) and (ACell = Master) then
+          begin
+          if (Value > 0) and (Value <= 110) then HeightAttr := Value*10;
+          HtAsPercent := True;
+          end
+        else HeightAttr := Value;
+      BGColorSy:
+        BkGnd := GetColor(Name, BkColor);
+      BorderColorSy:
+        BdrOn := GetColor(Name, BdrColor);
+      HSpaceSy: HSpace := IntMin(40, Abs(Value));   
+      VSpaceSy: VSpace := IntMin(200, Abs(Value));   
+      end;
+if Border then Inc(CellSpacing, 2);   {includes border lines}
+if Border then CellSpacing := IntMax(1, CellSpacing);
+end;
+
+{----------------ThtmlTable.Destroy}
+destructor ThtmlTable.Destroy;
+begin
+Rows.Free;
+Caption.Free;
+inherited Destroy;
+end;
+
+procedure ThtmlTable.UpdateFonts;
+var
+  I: integer;
+begin
+for I := 0 to Rows.Count-1 do
+  TCellList(Rows.Items[I]).UpdateFonts;
+Caption.UpdateFonts;
+end;
+
+{----------------ThtmlTable.AddDummyCells}
+procedure ThtmlTable.AddDummyCells;
+var
+  Cl, Rw, K, RowCount: integer;
+  AnyAbsolute: boolean;
+
+  function DummyCell(RSpan: integer): TCellObj;
+  begin
+  Result := TCellObj.Create(ParentSectionList, ATop, Nil);
+  Result.ColSpan := 0;
+  Result.RowSpan := RSpan;
+  end;
+
+Begin
+if not BkGnd and (MyCell.BkGnd) then
+  begin    {Transfer any Background colors}
+  BkGnd := True;
+  BkColor := MyCell.BkColor;
+  end;
+
+RowCount := Rows.Count;
+if not ListsProcessed then
+  begin   {put dummy cells in rows to make up for ColSpan > 1}
+  NumCols := 0;
+  AnyAbsolute := False;
+  for Rw := 0 to RowCount-1 do
+    begin
+    with TCellList(Rows[Rw]) do
+      begin
+      InitializeRow;
+      for Cl := Count-1 downto 0 do
+        with TCellObj(Items[Cl]) do
+          begin
+          if WidthAttr > 0 then
+            begin
+            if not AsPercent then AnyAbsolute := True;
+            end;
+          if Self.BkGnd and not Cell.BkGnd then    {transfer bgcolor to cells}
+            begin
+            Cell.BkGnd := True;
+            Cell.BkColor := Self.BkColor;
+            end;
+          for K := 1 to ColSpan-1 do
+            if RowSpan > 1 then
+              TCellList(Rows[Rw]).Insert(Cl+K, DummyCell(RowSpan)) {these could be
+                Nil also except they're needed for expansion in the next section}
+            else
+              TCellList(Rows[Rw]).Insert(Cl+K, Nil);   
+          end;
+      end;
+    NumCols := IntMax(NumCols, TCellList(Rows[Rw]).Count);  {temporary # cols}
+    end;
+
+  {Absolute calc only if  some absolute widths entered}
+  UseAbsolute := AnyAbsolute;  
+
+  {put dummy cells in cols to make up for RowSpan > 1}
+  for Cl := 0 to NumCols-1 do
+    for Rw := 0 to RowCount-1 do
+      with TCellList(Rows[Rw]) do
+        if Count > Cl then
+          if Assigned(Items[Cl]) then  
+            with TCellObj(Items[Cl]) do
+              begin
+              RowSpan := IntMin(RowSpan, RowCount-Rw);  {practical limit}
+              if RowSpan > 1 then
+                for K := Rw+1 to Rw+RowSpan-1 do
+                  begin  {insert dummy cells in following rows if RowSpan > 1}
+                  while TCellList(Rows[K]).Count < Cl do {add padding if row is short}
+                     TCellList(Rows[K]).Add(DummyCell(0));
+                  TCellList(Rows[K]).Insert(Cl, DummyCell(0));
+                  end;
+              end;
+
+  NumCols := 0;  {find the number of columns}     
+  for Rw := 0 to RowCount-1 do
+    begin
+    NumCols := IntMax(NumCols, TCellList(Rows[Rw]).Count);
+    end;
+  if NumCols > MaxCols then
+    Raise EProcessError.Create('Table has too many Columns');
+
+  ListsProcessed := True;
+  end;    {if not ListsProcessed}
+end;
+
+{----------------ThtmlTable.GetMinMaxAbs}
+procedure ThtmlTable.GetMinMaxAbs(Canvas: TCanvas; var TotalMinWidth,
+     TotalMaxWidth: integer; var MinWidths, MaxWidths: IntArray);
+var
+  I, J, Min, Max, N, Span, Addon, D: integer;
+  More: boolean;
+
+Begin
+FillChar(MinWidths, Sizeof(MinWidths), 0);
+FillChar(MaxWidths, Sizeof(MaxWidths), 0);
+Addon := 2*CellPadding + CellSpacing;
+Span := 1;
+More := True;
+while More do
+  begin
+  More := False;
+  for J := 0 to Rows.Count-1 do
+    with TCellList(Rows[J]) do
+      begin
+      for I := 0 to Count-1 do
+        if Assigned(Items[I]) then    
+          with TCellObj(Items[I]) do
+            begin
+            More := More or (ColSpan > Span); {set if need another iteration}
+            if ColSpan = Span then
+              begin
+              Cell.MinMaxWidth(Canvas, Min, Max);
+              Inc(Min, Addon);
+              Inc(Max, Addon);
+              if Span = 1 then
+                begin
+                if not AsPercent and (WidthAttr > 0) then
+                  begin
+                  Min := IntMax(Min, WidthAttr+Addon);
+                  Max := IntMax(Min, WidthAttr+Addon);
+                  end;
+                MinWidths[I] := Intmax(MinWidths[I], Min);
+                MaxWidths[I] := Intmax(MaxWidths[I], Max);
+                end
+              else
+                begin
+                TotalMinWidth := 0;  TotalMaxWidth := 0;
+                for N := I to I+ColSpan-1 do
+                  begin   {find the current totals for the span}
+                  Inc(TotalMaxWidth, MaxWidths[N]);
+                  Inc(TotalMinWidth, MinWidths[N]);
+                  end;
+                if not AsPercent and (WidthAttr > 0) then
+                  begin
+                  Min := IntMax(Min, WidthAttr+Addon);
+                  Max := IntMax(Min, WidthAttr+Addon);
+                  end;
+                if (TotalMinWidth < Min) then
+                  if TotalMinWidth > 0 then
+                    begin
+                    D := Min - TotalMinWidth;
+                    for N := I to I+ColSpan-1 do  {increase the sub widths to match the span}
+                      MinWidths[N] := MinWidths[N]+MulDiv(MinWidths[N], D, TotalMinWidth);
+                    end
+                  else MinWidths[I] := Min;  {this for multiple empty cols}
+                if (TotalMaxWidth < Max) then
+                  if TotalMaxWidth > 0 then
+                    begin     {increase the sub widths to match the span}
+                    D := Max - TotalMaxWidth;
+                    for N := I to I+ColSpan-1 do  {increase the sub widths to match the span}
+                      MaxWidths[N] := MaxWidths[N]+MulDiv(MaxWidths[N], D, TotalMaxWidth);
+                    end
+                  else MaxWidths[I] := Max;
+                end;
+              end;
+            end;
+      end;
+  Inc(Span);
+  end;
+
+{Find the total min and max width}
+TotalMaxWidth := 0;  TotalMinWidth := 0;
+for I := 0 to NumCols-1 do
+  begin
+  Inc(TotalMaxWidth, MaxWidths[I]);
+  Inc(TotalMinWidth, MinWidths[I]);
+  end;
+
+end;
+
+{----------------ThtmlTable.GetWidthsAbs}
+procedure ThtmlTable.GetWidthsAbs(Canvas: TCanvas; TablWidth: integer;
+            Specified: boolean; var MinWidths, MaxWidths: IntArray);
+var
+  N, D, W, dd, TotalMinWidth, TotalMaxWidth: integer;
+
+Begin
+GetMinMaxAbs(Canvas, TotalMinWidth, TotalMaxWidth, MinWidths, MaxWidths);
+
+if TotalMinWidth >=TablWidth then  {use the minimum column widths, table will expand}
+  Move(MinWidths, Widths, Sizeof(MinWidths))
+else if (TotalMaxWidth <= TablWidth) and not Specified then  
+  {use the max column widths, table will be smaller}
+  Move(MaxWidths, Widths, Sizeof(MaxWidths))
+else  {make table fit}
+  begin
+  D := TotalMaxWidth - TotalMinWidth;
+  W := TablWidth - TotalMinWidth;
+  if D > 0 then  {expand only those columns with some slop in them}
+    begin
+    for  N := 0 to NumCols-1 do
+      begin
+      dd := MaxWidths[N] - MinWidths[N];  {some dd's may be 0}
+      Widths[N] := MinWidths[N] + MulDiv(dd, W, D);
+      end;
+    end
+  else  {no adjustable columns, will have to expand them all}
+    for N := 0 to NumCols-1 do
+      Widths[N] := MinWidths[N] + MulDiv(MinWidths[N], W, TotalMinWidth);
+  end;
+end;
+
+{----------------ThtmlTable.GetWidths}
+procedure ThtmlTable.GetWidths(Canvas: TCanvas; var TotalMinWidth, TotalMaxWidth: integer;
+          var MinWidths, MaxWidths: IntArray; TheWidth: integer);
+var
+  I, J, Min, Max, N, Span, Addon, Distributable, TotalPC,
+  ExcessMin, ExcessMax, NonPC, PCWidth, NewTotalPC, MaxSum: integer;
+  More: boolean;
+
+Begin
+{Find the max and min widths of each column}
+FillChar(MaxWidths, Sizeof(MaxWidths), 0);
+FillChar(MinWidths, Sizeof(MinWidths), 0);
+FillChar(Percents, Sizeof(Percents), 0);
+Addon := 2*CellPadding + CellSpacing;
+Span := 1;
+More := True;
+while More do
+  begin
+  More := False;
+  for J := 0 to Rows.Count-1 do
+    with TCellList(Rows[J]) do
+      begin
+      for I := 0 to Count-1 do
+        if Assigned(Items[I]) then  
+          with TCellObj(Items[I]) do
+            begin
+            PCWidth := 0;
+            if WidthAttr > 0 then
+              if AsPercent then PCWidth := WidthAttr
+              else if TheWidth > 0 then
+                PCWidth := IntMin(1000, MulDiv(WidthAttr, 1000, TheWidth));
+            More := More or (ColSpan > Span); {set if need another iteration}
+            if ColSpan = Span then
+              begin
+              Cell.MinMaxWidth(Canvas, Min, Max);
+              Inc(Min, Addon);
+              Inc(Max, Addon);
+              if Span = 1 then
+                begin
+                MaxWidths[I] := IntMax(MaxWidths[I],  Max);
+                MinWidths[I] := IntMax(MinWidths[I],  Min);
+                Percents[I] := Intmax(Percents[I], PCWidth);  {collect percents}
+                end
+              else
+                begin
+                TotalMaxWidth := 0;  TotalMinWidth := 0;
+                TotalPC := 0;  NonPC := 0;
+                for N := I to I+ColSpan-1 do
+                  begin   {Total up the pertinant column widths}
+                  Inc(TotalMaxWidth, MaxWidths[N]);
+                  Inc(TotalMinWidth, MinWidths[N]);
+                  if Percents[N] > 0 then
+                    Inc(TotalPC, Percents[N])  {total percents}
+                  else Inc(NonPC);      {count of cell with no percent}
+                  end;
+                ExcessMin := Min - TotalMinWidth;
+                ExcessMax := Max - TotalMaxWidth;
+                if (PCWidth > 0) or (TotalPC > 0) then
+                  begin   {manipulate for percentages}
+                  if NonPC > 0 then
+                    {find the extra percentages to divvy up}
+                    Distributable := IntMax(0, (PCWidth-TotalPC) div NonPC)
+                  else Distributable := 0;
+                  if (NonPC = 0) and (PCWidth > TotalPC) then
+                    begin
+                    for  N := I to I+ColSpan-1 do  {stretch percentages to fit}
+                      Percents[N] := MulDiv(Percents[N], PCWidth, TotalPC);
+                    end
+                  else if Distributable > 0 then    {spread colspan percentage excess over the unspecified cols}
+                    for N := I to I+ColSpan-1 do
+                      if Percents[N] = 0 then Percents[N] := Distributable;
+                  NewTotalPC := IntMax(TotalPC, PCWidth);
+                  if ExcessMin > 0 then
+                    begin
+                    if NonPC > 0 then  {split excess over non-specified cells}
+                      begin
+                      {proportion the distribution so cells with large MaxWidth get more}
+                      MaxSum := 0;
+                      for  N := I to I+ColSpan-1 do
+                        if Percents[N] = 0 then
+                          Inc(MaxSum, MaxWidths[N]);
+                      for  N := I to I+ColSpan-1 do
+                        if Percents[N] = 0 then
+                          Inc(MinWidths[N], MulDiv(ExcessMin, MaxWidths[N], MaxSum));
+                      end
+                    else
+                      for  N := I to I+ColSpan-1 do
+                        MinWidths[N] := IntMax(MulDiv(Min, Percents[N], NewTotalPC), MinWidths[N]);
+                    end;
+                  if ExcessMax > 0 then
+                    begin
+                    if NonPC > 0 then  {split excess over non-specified cells}
+                      begin
+                      Distributable := ExcessMax div NonPC;
+                      for  N := I to I+ColSpan-1 do
+                        if Percents[N] = 0 then
+                          Inc(MaxWidths[N], Distributable);
+                      end
+                    else
+                      for  N := I to I+ColSpan-1 do
+                        MaxWidths[N] := IntMax(MulDiv(Max, Percents[N], NewTotalPC), MaxWidths[N]);
+                    end;
+                  end
+                else
+                  begin  {no width dimensions entered}
+                  if ExcessMin > 0 then
+                    for  N := I to I+ColSpan-1 do
+                      if TotalMinWidth = 0 then
+                        MinWidths[N] := Min div ColSpan
+                      else  {split up the widths in proportion to widths already there}
+                        MinWidths[N] := MulDiv(Min, MinWidths[N], TotalMinWidth);
+                  if ExcessMax > 0 then
+                    for  N := I to I+ColSpan-1 do
+                      if TotalMaxWidth = 0 then
+                        MaxWidths[N] := Max div ColSpan
+                      else   {split up the widths in proportion to widths already there}
+                        MaxWidths[N] := MulDiv(Max, MaxWidths[N], TotalMaxWidth);
+                  end;
+                end;
+              end;
+            end;
+      end;
+  Inc(Span);
+  end;
+
+TotalMaxWidth := 0;  TotalMinWidth := 0;
+for I := 0 to NumCols-1 do
+  begin
+  Inc(TotalMaxWidth, MaxWidths[I]);
+  Inc(TotalMinWidth, MinWidths[I]);
+  end;
+end;
+
+{----------------ThtmlTable.MinMaxWidth}
+procedure ThtmlTable.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer);
+var
+  MaxWidths, MinWidths: IntArray;
+  Mn, Dummy: integer;
+begin
+AddDummyCells;     {in case it hasn't been done}
+if UseAbsolute and (WidthAttr = 0) then
+  GetMinMaxAbs(Canvas, Mn, Max, MinWidths, MaxWidths)
+else if not AsPercent then
+  GetWidths(Canvas, Mn, Max, MinWidths, MaxWidths, WidthAttr)
+else
+  GetWidths(Canvas, Mn, Max, MinWidths, MaxWidths, 0);
+
+Inc(Mn, CellSpacing);
+Inc(Max, CellSpacing);
+if not AsPercent then
+  begin
+  Mn := IntMax(Mn, WidthAttr);
+  Max := IntMax(Max, WidthAttr);
+  end;
+Caption.Cell.MinMaxWidth(Canvas, CaptionMinWidth, Dummy);
+Min := IntMax(CaptionMinWidth, Mn);  {caption may be wider than table}
+Max := IntMax(CaptionMinWidth, Max);
+end;
+
+procedure ThtmlTable.xxx(const MaxWidths, MinWidths: IntArray; TheWidth: integer);
+{Divide up the table into columns.  TheWidth is the specified width of the table.
+ At this point, it is known that everything will fit into TheWidth. Percents are
+ being used}
+var
+  I, W, PCNotMinWid, TotalWid, Unsp, UnspDiff, Delta, Addon, Count: integer;
+  UseMin: array[0..MaxCols] of boolean;
+  NoChange: boolean;
+begin
+FillChar(UseMin, Sizeof(UseMin), False);
+PCNotMinWid := 0;  TotalWid := 0;  Unsp := 0; UnspDiff := 0;
+{First calculate everything assuming the data entered is perfectly correct}
+for I := 0 to NumCols - 1 do
+  begin
+  if Percents[I] > 0 then
+    begin
+    W := MulDiv(TheWidth, Percents[I], 1000);  {width based on percentage}
+    if W > MinWidths[I] then
+      begin
+      Widths[I] := W;
+      Inc(PCNotMinWid, Percents[I]);
+      end
+    else
+      begin   {percent is too small, use Min width}
+      Widths[I] := MinWidths[I];
+      UseMin[I] := True;
+      end;
+    end
+  else
+    begin    {no percent}
+    Widths[I] := MinWidths[I];
+    Inc(Unsp);     {an unspecified column}
+    Inc(UnspDiff, MaxWidths[I]-MinWidths[I]); {total max-min for unspecified cols}
+    end;
+  Inc(TotalWid, Widths[I]);
+  end;
+
+Delta := TotalWid - TheWidth;    {see what the error is}
+if Delta < 0 then     {table is too small}
+  begin
+  if Unsp > 0 then
+    begin
+    if (UnspDiff > 0) and (UnspDiff >= Abs(Delta) div 2) then  
+      {increase the unspecified columns widths prop to Max, Min unless the difference is trivial}
+      begin
+      for I := 0 to NumCols-1 do
+        if (Percents[I] = 0) then
+          Inc(Widths[I], MulDiv(-Delta, MaxWidths[I] - MinWidths[I], UnspDiff));
+      end
+    else
+      begin  {increase the unspecified columns widths uniformly}
+      Addon := -Delta div Unsp;
+      for I := 0 to NumCols - 1 do
+        if (Percents[I] = 0) then
+          Inc(Widths[I], Addon);
+      end;
+    end
+  else
+    begin            {no unspecified widths, increase the specified columns which are not minimum}
+    for I := 0 to NumCols - 1 do
+      if (Percents[I] > 0) and not UseMin[I] then
+        Inc(Widths[I], MulDiv(-Delta, Percents[I], PCNotMinWid));
+    end;
+  end
+else if Delta > 0 then    {calculated table is too large}
+  begin
+  Count := 0;
+  {make one or more trial run to see what happens when shrinking the columns
+   that can be shrunck.  May hit another MinWidth situation}
+  repeat
+    NoChange := True;
+    for I := 0 to NumCols - 1 do
+      if (Percents[I] > 0) and not UseMin[I] then
+        begin
+        W := Widths[I] - MulDiv(Delta, Percents[I], PCNotMinWid);
+        if W < MinWidths[I] then
+          begin    {new width is smaller than MinWidth, make adustments}
+          UseMin[I] := True;
+          NoChange := False;
+          Dec(PCNotMinWid, Percents[I]);
+          Dec(Delta, Widths[I]-MinWidths[I]);
+          Widths[I] := MinWidths[I];
+          end;
+        end;
+    Inc(Count);
+  until NoChange or (Count >= 4);   {count guards against endless loop}
+  for I := 0 to NumCols - 1 do  {now actually change the widths}
+    if (Percents[I] > 0) and not UseMin[I] then
+      Dec(Widths[I], MulDiv(Delta, Percents[I], PCNotMinWid));
+  end;
+
+TotalWid := 0;     {fix up any round off errors}
+for I := 0 to NumCols - 1 do
+  Inc(TotalWid, Widths[I]);
+Delta := TotalWid-TheWidth;     {round off error}
+if Delta > 0 then
+  begin
+  for I := 0 to NumCols-1 do
+    if not UseMin[I] then
+      begin
+      Dec(Widths[I], Delta);   {remove extra from first non minimum}
+      Break;
+      end;
+  end
+else Inc(Widths[0], -Delta);   {tack it on anywhere}
+end;
+
+{----------------ThtmlTable.DrawLogic}
+function ThtmlTable.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer;
+Label
+  GotWidths;
+type
+  HeightArray = array[0..16000] of integer;
+var
+  I, J, K, N, Span,
+  TotalMaxWidth, TotalMinWidth, D, W, DS,
+  Total, TotalPC, Residual, NewResidual, W1, W2, NewTotal: integer;
+  More, Mr, HasPercents, UsesPercents, Done: boolean;
+  MaxWidths, MinWidths: IntArray;
+  NewWidth, Dummy: integer;
+  Heights: ^HeightArray;
+  OwnerWidth: integer;
+  H, TotalHt, Addon: integer;
+  Specified: boolean;     
+  AddedOn: integer;
+  DisplayHt, NewHeight, Sum: integer;  
+
+Begin
+YValue := Y;
+StartCurs := Curs;
+IMgr.SetLevel(Y, Level);    
+
+OwnerWidth := IMgr.RightSide(Y) - IMgr.LeftIndent(Y);
+if WidthAttr > 0 then
+  begin
+  Specified := True;   
+  if AsPercent then
+    NewWidth := MulDiv(OwnerWidth, WidthAttr, 1000)
+  else NewWidth := WidthAttr;
+  end
+else
+  begin
+  Specified := False;    
+  NewWidth := OwnerWidth;
+  end;
+Dec(NewWidth, CellSpacing);
+NewWidth := IntMax(NewWidth, 20);
+
+AddDummyCells;
+
+{Figure the width of each column}
+if UseAbsolute and not Specified then  
+  begin
+  GetWidthsAbs(Canvas, NewWidth, Specified, MinWidths, MaxWidths); {fills in Widths array}
+  GoTo GotWidths;
+  end
+else
+  GetWidths(Canvas, TotalMinWidth, TotalMaxWidth, MinWidths, MaxWidths, NewWidth); 
+
+if (TotalMinWidth >= NewWidth) then        
+  begin   {table won't fit, use minimun widths}
+  Move(MinWidths, Widths, Sizeof(IntArray));
+  GoTo GotWidths;
+  end;
+
+if Specified then
+  begin
+  xxx(MaxWidths, MinWidths, NewWidth);
+  GoTo GotWidths;
+  end;
+
+TotalPC := 0;   {see if any percentage widths entered}
+for I := 0 to NumCols-1 do
+  Inc(TotalPC, Percents[I]);
+UsesPercents := (TotalPc > 0) and (TotalPc <= 1000) {ignore ridiculous values}
+                 or (WidthAttr > 0);
+
+if UsesPercents then
+  begin {find the largest width that will accomodate the %'s}
+  Residual := 0; W1 := 0; W2 := 0;
+  for I := 0 to NumCols-1 do
+    if Percents[I] > 0 then  {a percent has been entered}
+      W1 := IntMax(W1, MulDiv(MaxWidths[I], 1000, Percents[I])) {look for maximum}
+    else
+      Inc(Residual, MaxWidths[I]);  {accumlate the cols which have no percent}
+  if TotalPC < 1000 then
+    W2 := MulDiv(Residual, 1000, 1000-TotalPC)
+  else if Residual > 0 then W2 := 30000
+  else W2 := 0;
+  Total := IntMax(W1, W2);
+  if Total <= NewWidth then
+    begin  {a fit is found using percents and maxwidths}
+    if WidthAttr > 0 then
+      Total := NewWidth;    {don't try to make it smaller than NewWidth}  
+    NewResidual := MulDiv(Total, 1000-TotalPC, 1000);
+    for I := 0 to NumCols-1 do
+      if Percents[I] > 0 then   {figure widths to fit this situation}
+        Widths[I] := MulDiv(Total, Percents[I], 1000)
+      else if Residual > 0 then
+        Widths[I] := MulDiv(MaxWidths[I], NewResidual, Residual)
+      else Widths[I] := 0;    {this is an table syntax error condition}
+    GoTo GotWidths;
+    end;
+
+  Done := False;
+  repeat  {with the above possibilites taken care of, we can assume the final
+           width will = NewWidth}
+    HasPercents := False;
+    Total := 0;  Residual := 0;
+    for I := 0 to NumCols-1 do
+      begin
+      if Percents[I] > 0 then
+        begin
+        W := MulDiv(NewWidth, Percents[I], 1000)-1; {a Percent's width based on NewWidth}
+        if W < MinWidths[I] then  {but it must be > MinWidth}
+          begin   {eliminate the percentage value as not achievable}
+          Percents[I] := 0;
+          Inc(Residual, MinWidths[I]);  {and put it in the residuals}
+          end
+        else
+          begin
+          HasPercents := True;   {still valid percents}
+          Inc(Total, W);
+          end;
+        end
+      else Inc(Residual, MinWidths[I]);
+      end;
+    if not HasPercents then Break;  {no percents are achievable}
+    if Total+Residual <= NewWidth then
+      begin  {a solution with at least some percentages can be found}
+      Done := True;
+      TotalMaxWidth := 0;  TotalMinWidth := 0;  {recalc these}
+      for I := 0 to NumCols-1 do
+        begin
+        if Percents[I] > 0 then
+          begin
+          MinWidths[I] := MulDiv(NewWidth, Percents[I], 1000);
+          MaxWidths[I] := MinWidths[I];  {this fixes the width thru later calculations}
+          end;
+        Inc(TotalMaxWidth, MaxWidths[I]);
+        Inc(TotalMinWidth, MinWidths[I]);
+        end;
+      end
+    else  {it doesn't fit screen, reduce percentages and try again}
+      begin
+      NewTotal := NewWidth-Residual;  {percent items must fit this}
+      for I := 0 to NumCols-1 do
+        if Percents[I] > 0 then
+          Percents[I] := integer(Percents[I]) * NewTotal div Total;
+      end;
+  until Done;
+  end;
+
+D := TotalMaxWidth - TotalMinWidth;
+if (TotalMaxWidth <= NewWidth) or (D = 0) then
+  Move(MaxWidths, Widths, Sizeof(IntArray))
+else
+  begin
+  W := NewWidth - TotalMinWidth;
+  for I := 0 to NumCols-1 do
+    begin
+    ds := MaxWidths[I] - MinWidths[I];
+    Widths[I] := MinWidths[I] + MulDiv(ds, W, D);
+    end;
+  end;
+
+GotWidths:
+
+{Find Table Width}
+TableWidth := CellSpacing;
+for I := 0 to NumCols-1 do
+  Inc(TableWidth, Widths[I]);
+Caption.Cell.MinMaxWidth(Canvas, CaptionMinWidth, Dummy);
+CaptionWidth := IntMax(TableWidth, CaptionMinWidth); {make sure caption fits}
+
+GetMem(Heights, Rows.Count * Sizeof(integer));
+try
+  {Find the height of each row allowing for RowSpans}
+  FillChar(Heights^, Rows.Count*Sizeof(integer), 0);
+  Span := 1;
+  More := True;
+  while More do
+    begin
+    More := False;
+    for J := 0 to Rows.Count-1 do
+      with TCellList(Rows[J]) do
+        begin
+        if J+Span > Rows.Count then Break;  {otherwise will overlap}
+        H := DrawLogic1(Canvas, Widths, Span, CellPadding, CellSpacing, Mr) +
+               + 2*CellPadding+CellSpacing;
+        More := More or Mr;
+        if Span = 1 then
+          Heights^[J] := H
+        else
+          begin
+          TotalHt := 0;  {sum up the height so far for the rows involved}
+          for K := J to J+Span-1 do
+            Inc(TotalHt, Heights^[K]);
+          if H > TotalHt then   {apportion the excess over the rows}
+            begin
+            Addon := ((H-TotalHt) div Span);
+            AddedOn := 0;
+            for K := J to J+Span-1 do
+              begin
+              Inc(Heights^[K], Addon);
+              Inc(AddedOn, Addon);
+              end;
+            Inc(Heights^[J+Span-1], (H-TotalHt)-AddedOn); {make up for round off error}
+            end;
+          end;
+        end;
+    Inc(Span);
+    end;
+
+  if TopCaption then
+    begin         {layout the caption}
+    SectionHeight := Caption.Cell.DoLogic(Canvas, Y, CaptionWidth, Dummy, Curs, 0, 0);
+    CaptionHeight := SectionHeight;
+    Inc(Y, SectionHeight);
+    end
+  else SectionHeight := 0;
+
+  if HeightAttr > 0 then   
+    begin
+    if HtAsPercent then
+      with ThtmlLite(ParentSectionList.TheOwner) do
+        begin
+        DisplayHt := ClientHeight - 2*FMarginHeightX - CellSpacing - 3;
+        NewHeight := MulDiv(DisplayHt, HeightAttr, 1000);
+        end
+    else NewHeight := HeightAttr;
+    TotalHt := 0;
+    for J := 0 to Rows.Count-1 do
+      Inc(TotalHt, Heights^[J]);
+    if TotalHt < NewHeight then
+      begin
+      Addon := (NewHeight-TotalHt) div Rows.Count;
+      Sum := 0;
+      for J := 0 to Rows.Count-2 do
+        begin
+        Inc(Heights^[J], Addon);
+        Inc(Sum, Heights^[J]);
+        end;
+      Heights^[Rows.Count-1] := NewHeight-Sum;
+      end;
+    end;   
+
+  TableHeight := SectionHeight;
+  for J := 0 to Rows.Count-1 do
+    with  TCellList(Rows[J]) do
+      begin
+      RowHeight := Heights^[J];
+      RowSpanHeight := 0;        
+      Inc(SectionHeight, Heights^[J]);
+      for I := 0 to Count-1 do
+        if Assigned(Items[I]) then  
+          with TCellObj(Items[I]) do
+            begin   {find the actual height, Ht, of each cell}
+            Ht := 0;
+            for K := J to J+RowSpan-1 do
+              Inc(Ht, Heights^[K]);
+            if RowSpanHeight < Ht then RowSpanHeight := Ht;
+            end;
+      DrawLogic2(Canvas, Y, CellPadding, CellSpacing, Curs);
+      Inc(Y, RowHeight);
+      end;
+  Inc(SectionHeight, CellSpacing);
+  TableHeight := SectionHeight-TableHeight;
+Finally
+  FreeMem(Heights, Rows.Count * Sizeof(integer));
+  end;
+
+if not TopCaption then
+  begin
+  CaptionHeight := Caption.Cell.DoLogic(Canvas, YValue+TableHeight,
+                   CaptionWidth, Dummy, Curs, 0, 0);
+  Inc(SectionHeight, CaptionHeight);
+  end;
+
+{figure the indents, CaptionWidth is = or larger than TableWidth}
+CaptionIndent := 0;
+if CaptionWidth < OwnerWidth then
+case Justify of
+  Centered: CaptionIndent := (OwnerWidth-CaptionWidth) div 2;
+  Right: CaptionIndent := OwnerWidth-CaptionWidth;
+  end;
+Inc(CaptionIndent, IMgr.LeftIndent(YValue));     
+Indent := CaptionIndent + (CaptionWidth-TableWidth) div 2; {table indent}
+
+Len := Curs-StartCurs;
+MaxWidth := CaptionWidth;
+if Float then             
+  begin
+  Inc(SectionHeight, 2*VSpace);   
+  IMgr.UpdateTable(YValue, MaxWidth+HSpace+1, SectionHeight, Justify);
+  DrawHeight := SectionHeight;
+  SectionHeight := 0;
+  Result := 0;
+  end
+else
+  begin
+  Result := SectionHeight;
+  DrawHeight := Result;
+  end;
+end;
+
+{----------------ThtmlTable.Draw}
+function ThtmlTable.Draw(Canvas: TCanvas; const ARect: TRect;
+     IMgr: IndentManager; X: integer; Y: integer) : integer;
+var
+  I, XX: integer;
+  YY, YTable, YO, YOffset: integer;
+  Rgn: THandle;
+begin
+Result := Y+SectionHeight;
+if Float then        
+  Y := Y + VSpace;
+YOffset := ParentSectionList.YOff;
+YO := Y - YOffset;
+
+if (YO+DrawHeight >= ARect.Top) and (YO < ARect.Bottom) then
+  begin
+  XX := X+Indent;   {for the table}
+  YY := Y;
+  DrawX := XX;
+  DrawY := YY;
+  if TopCaption then
+    YY := Caption.Cell.Draw(Canvas, ARect, CaptionWidth, XX+CaptionIndent-Indent, YY);
+  YTable := YY;
+  if BdrOn then
+    begin
+    Rgn:= CreateRectRgn(XX, IntMax(Arect.Top-1, YTable-YOffset),
+             XX+TableWidth, IntMin(ARect.Bottom, YTable+TableHeight-YOffset));
+    end
+  else Rgn := 0;
+  for I := 0 to Rows.Count-1 do
+    YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths,
+            XX, YY, YOffset, CellPadding, CellSpacing, Border, Rgn, I);
+  if Rgn <> 0 then
+    begin
+    Canvas.Brush.Color := BdrColor or $2000000;
+    FillRgn(Canvas.Handle, Rgn, Canvas.Brush.Handle);
+    DeleteObject(Rgn);
+    end;
+  if Border then
+    RaisedRect(ParentSectionList, Canvas, XX, YTable-YOffset, XX+TableWidth-1,
+                                         YY+CellSpacing-YOffset-1, True);
+  if not TopCaption then
+    Caption.Cell.Draw(Canvas, ARect, CaptionWidth, XX+CaptionIndent-Indent,
+                          YTable+TableHeight);
+  end;
+end;
+
+{----------------ThtmlTable.GetURL}
+function ThtmlTable.GetURL(Canvas: TCanvas; X: integer; Y: integer;
+         var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean;
+{Y is relative to top of section}
+var
+  CaptionOK, TableOK: boolean;
+
+  function GetTableURL(X: integer; Y: integer): boolean;
+  var
+    I, J, XX, YY: integer;
+  begin
+  YY := 0;
+  for J := 0 to Rows.Count-1 do
+    begin
+    XX := DrawX;
+    with  TCellList(Rows[J]) do
+      begin
+      for I := 0 to Count-1 do
+        begin
+        if Assigned(Items[I]) then     
+          with TCellObj(Items[I]) do
+            begin
+            if (X >=XX) and (X < XX+Wd)
+                 and (Y >= YY) and (Y < YY+Ht) then
+              begin
+              Result := Cell.GetUrl(Canvas, X,
+                 Y-YY-(CellSpacing+CellPadding+YIndent), UrlTarg, FormControl);
+              Exit;
+              end;
+            end;
+        Inc(XX, Widths[I]); 
+        end;
+      Inc(YY, RowHeight);
+      end;
+    end;
+  Result := False;
+  end;
+
+begin
+Result := False;
+if (Y <= DrawHeight) then
+  begin
+  TableOK := (X >= DrawX) and (X <= TableWidth+DrawX);
+  CaptionOK := (X >= DrawX+CaptionIndent-Indent) and (X <= DrawX+CaptionWidth+CaptionIndent-Indent);
+  if TopCaption then
+    if Y < CaptionHeight then
+      begin
+      if CaptionOK then
+        Result := Caption.Cell.GetURL(Canvas, X, Y, UrlTarg, FormControl);
+      end
+    else
+      begin
+      if TableOK then
+        Result := GetTableURL(X, Y-CaptionHeight);
+      end
+  else
+    if Y < TableHeight then
+      begin
+      if TableOK then
+        Result := GetTableURL(X, Y);
+      end
+    else
+      begin
+      if CaptionOK then
+        Result := Caption.Cell.GetURL(Canvas, X, Y-TableHeight, UrlTarg, FormControl);
+      end;
+  end;
+end;
+
+function ThtmlTable.PtInObject(X : integer; Y: integer; var Obj: TObject;
+         var IX, IY: integer): boolean;
+{Y is relative to top of section}
+var
+  CaptionOK, TableOK: boolean;
+
+  function GetTableObj(X: integer; Y: integer): boolean;
+  var
+    I, J, XX, YY: integer;
+  begin
+  YY := 0;
+  for J := 0 to Rows.Count-1 do
+    begin
+    XX := DrawX;
+    with  TCellList(Rows[J]) do
+      begin
+      for I := 0 to Count-1 do
+        begin
+        if Assigned(Items[I]) then  
+          with TCellObj(Items[I]) do
+            begin
+            if (X >=XX) and (X < XX+Wd)
+                 and (Y >= YY) and (Y < YY+Ht) then
+              begin
+              Result := Cell.PtInObject(X, Y-YY-(CellSpacing+CellPadding+YIndent),
+                           Obj, IX, IY);
+              Exit;
+              end;
+            end;
+        Inc(XX, Widths[I]);      
+        end;
+      Inc(YY, RowHeight);
+      end;
+    end;
+  Result := False;
+  end;
+
+begin
+Result := False;
+if (Y <= DrawHeight) then
+  begin
+  TableOK := (X >= DrawX) and (X <= TableWidth+DrawX);
+  CaptionOK := (X >= DrawX+CaptionIndent-Indent) and (X <= DrawX+CaptionWidth+CaptionIndent-Indent);
+  if TopCaption then
+    if Y < CaptionHeight then
+      begin
+      if CaptionOK then
+        Result := Caption.Cell.PtInObject(X, Y, Obj, IX, IY);
+      end
+    else
+      begin
+      if TableOK then
+        Result := GetTableObj(X, Y-CaptionHeight);
+      end
+  else
+    if Y < TableHeight then
+      begin
+      if TableOK then
+        Result := GetTableObj(X, Y);
+      end
+    else
+      begin
+      if CaptionOK then
+        Result := Caption.Cell.PtInObject(X, Y-TableHeight, Obj, IX, IY);
+      end;
+  end;
+end;
+
+{----------------ThtmlTable.FindCursor}
+function ThtmlTable.FindCursor(Canvas: TCanvas; X: integer; Y: integer;
+         var XR: integer; var YR: integer; var CaretHt: integer;
+         var SCell: TObject; var Intext: boolean): integer;
+{Y is relative to top of section}
+var
+  CaptionOK, TableOK: boolean;
+
+  function GetTableCursor(X: integer; Y: integer; var XR: integer;
+           var YR: integer; var CaretHt: integer; var Intext: boolean): integer;
+  var
+    I, J, XX, YY: integer;
+  begin
+  YY := 0;
+  for J := 0 to Rows.Count-1 do
+    begin
+    XX := DrawX;
+    with  TCellList(Rows[J]) do
+      begin
+      for I := 0 to Count-1 do
+        begin
+        if Assigned(Items[I]) then  
+          with TCellObj(Items[I]) do
+            begin
+            if (X >=XX) and (X < XX+Wd)
+                 and (Y >= YY) and (Y < YY+Ht) then
+              begin
+              Result := Cell.FindCursor(Canvas, X,
+                 Y-YY-(CellSpacing+CellPadding+YIndent), XR, YR, CaretHt, SCell, InText);
+              Inc(YR, YY+(CellSpacing+CellPadding+YIndent));
+              Exit;
+              end;
+            end;
+        Inc(XX, Widths[I]);   
+        end;
+      Inc(YY, RowHeight);
+      end;
+    end;
+  Result := -1;
+  end;
+
+begin
+Result := -1;
+if (Y <= SectionHeight) then
+  begin
+  TableOK := (X >= DrawX) and (X <= TableWidth+DrawX);
+  CaptionOK := (X >= DrawX+CaptionIndent-Indent) and (X <= DrawX+CaptionWidth+CaptionIndent-Indent);
+  if TopCaption then
+    if Y < CaptionHeight then
+      begin
+      if CaptionOK then
+        begin
+        Result := Caption.Cell.FindCursor(Canvas, X, Y, XR, YR, CaretHt, SCell, InText);
+        end;
+      end
+    else
+      begin
+      if TableOK then
+        begin
+        Result := GetTableCursor(X, Y-CaptionHeight, XR, YR, CaretHt, InText);
+        Inc(YR, CaptionHeight);
+        end;
+      end
+  else
+    if Y < TableHeight then
+      begin
+      if TableOK then
+        begin
+        Result := GetTableCursor(X, Y, XR, YR, CaretHt, InText);
+        end;
+      end
+    else
+      begin
+      if CaptionOK then
+        begin
+        Result := Caption.Cell.FindCursor(Canvas, X, Y-TableHeight,
+                  XR, YR, CaretHt, SCell, InText);
+        Inc(YR, TableHeight);
+        end;
+      end;
+  end;
+end;
+
+function ThtmlTable.CursorToXY(Canvas: TCanvas; Cursor: integer;
+                                var X: integer; var Y: integer): boolean;
+{note: returned X value is not correct here but it isn't used}
+var
+  I, J: integer;
+begin
+Result := False;
+if (Len = 0) or (Cursor > StartCurs + Len) then Exit;
+if TopCaption then
+  begin
+  Result := Caption.Cell.CursorToXy(Canvas, Cursor, X, Y);
+  if Result then Exit;
+  end;
+for J := 0 to Rows.Count-1 do
+  with  TCellList(Rows[J]) do
+    for I := 0 to Count-1 do
+      if Assigned(Items[I]) then 
+        with TCellObj(Items[I]) do
+          begin
+          Result := Cell.CursorToXy(Canvas, Cursor, X, Y);
+          if Result then Exit;
+          end;
+if not TopCaption then
+  Result := Caption.Cell.CursorToXy(Canvas, Cursor, X, Y);
+end;
+
+{----------------ThtmlTable.GetChAtPos}
+function ThtmlTable.GetChAtPos(Pos: integer; var Ch: char; var Obj: TObject): boolean;
+var
+  I, J: integer;
+begin
+Result := False;
+if (Len = 0) or (Pos < StartCurs) or (Pos > StartCurs + Len) then Exit;
+
+Result := Caption.Cell.GetChAtPos(Pos, Ch, Obj);
+if Result then Exit;
+
+for J := 0 to Rows.Count-1 do
+  with  TCellList(Rows[J]) do
+    for I := 0 to Count-1 do
+      if Assigned(Items[I]) then 
+        with TCellObj(Items[I]) do
+          begin
+          Result := Cell.GetChAtPos(Pos, Ch, Obj);
+          if Result then Exit;
+          end;
+end;
+
+{----------------ThtmlTable.FindString}
+function ThtmlTable.FindString(From: integer; PC: PChar;
+                              MatchCase: boolean): integer;
+var
+  I, J: integer;
+begin
+Result := -1;
+if TopCaption then
+  begin
+  Result := Caption.Cell.FindString(From, PC, MatchCase);
+  if Result >= 0 then Exit;
+  end;
+for J := 0 to Rows.Count-1 do
+    with  TCellList(Rows[J]) do
+      for I := 0 to Count-1 do
+        if Assigned(Items[I]) then 
+          with TCellObj(Items[I]) do
+            begin
+            Result := Cell.FindString(From, PC, MatchCase);
+            if Result >= 0 then Exit;
+            end;
+if not TopCaption then
+  Result := Caption.Cell.FindString(From, PC, MatchCase);
+end;
+
+{----------------ThtmlTable.FindSourcePos}
+function ThtmlTable.FindSourcePos(DocPos: integer): integer;   
+var
+  I, J: integer;
+begin
+Result := -1;
+if TopCaption then
+  begin
+  Result := Caption.Cell.FindSourcePos(DocPos);
+  if Result >= 0 then Exit;
+  end;
+for J := 0 to Rows.Count-1 do
+    with  TCellList(Rows[J]) do
+      for I := 0 to Count-1 do
+        if Assigned(Items[I]) then 
+          with TCellObj(Items[I]) do
+            begin
+            Result := Cell.FindSourcePos(DocPos);
+            if Result >= 0 then Exit;
+            end;
+if not TopCaption then
+  Result := Caption.Cell.FindSourcePos(DocPos);
+end;
+
+{----------------ThtmlTable.FindDocPos}
+function ThtmlTable.FindDocPos(SourcePos: integer; Prev: boolean): integer;   
+var
+  I, J: integer;
+begin
+if not Prev then
+  begin
+  Result := Caption.Cell.FindDocPos(SourcePos, Prev);
+  if Result >= 0 then Exit;
+
+  if not Prev then
+    for J := 0 to Rows.Count-1 do
+        with  TCellList(Rows[J]) do
+          for I := 0 to Count-1 do
+            if Assigned(Items[I]) then 
+              with TCellObj(Items[I]) do
+                begin
+                Result := Cell.FindDocPos(SourcePos, Prev);
+                if Result >= 0 then Exit;
+                end;
+  end
+else  //Prev , iterate in reverse
+  begin
+  for J := Rows.Count-1 downto 0 do
+      with  TCellList(Rows[J]) do
+        for I := Count-1 downto 0 do
+          if Assigned(Items[I]) then 
+            with TCellObj(Items[I]) do
+              begin
+              Result := Cell.FindDocPos(SourcePos, Prev);
+              if Result >= 0 then Exit;
+              end;
+  Result := Caption.Cell.FindDocPos(SourcePos, Prev);
+  end;
+end;
+
+{----------------ThtmlTable.CopyToClipboard}
+procedure ThtmlTable.CopyToClipboard;
+var
+  I, J: integer;
+begin
+if TopCaption then
+  Caption.Cell.CopyToClipboard;
+
+for J := 0 to Rows.Count-1 do
+    with  TCellList(Rows[J]) do
+      for I := 0 to Count-1 do
+        if Assigned(Items[I]) then 
+          with TCellObj(Items[I]) do
+            Cell.CopyToClipboard;
+if not TopCaption then
+  Caption.Cell.CopyToClipboard;
+end;
+
+{----------------TSection.Create}
+constructor TSection.Create(AMasterList: TSectionList; ALevel: integer; AFont: TMyFont; AnURL: TUrlTarget;
+            AJustify: JustifyType);
+var
+  FO : TFontObj;
+  F: TMyFont;
+  Parser: ThlParser;
+begin
+inherited Create(AMasterList);
+Parser := ThlParser(ParentSectionList.Parser);
+Buff := Nil;
+Len := 0;
+BuffSize := 0;
+Parser.CurrentSScript := Normal;
+Fonts := TFontList.Create;
+F := TMyFont.Create;
+F.Assign(AFont);
+F.Style := F.Style + Parser.CurrentStyle;
+FO := TFontObj.Create(Self, F, 0);
+if Assigned(AnURL) and (Length(AnURL.Url) > 0) then
+  begin
+  FO.UrlTarget.Assign(AnUrl.Url, AnUrl.Target);
+  ParentSectionList.LinkList.Add(FO);
+  end;
+Fonts.Add(FO);
+DefFont := TMyFont.Create;
+DefFont.Assign(F);
+
+Images := TImageObjList.Create;
+FormControls := TFormControlList.Create;
+
+Level := ALevel;
+Indent := ALevel * ListIndent;
+ListType := None;
+Lines := TFreeList.Create;
+Justify := AJustify;
+end;
+
+{----------------TSection.Destroy}
+destructor TSection.Destroy;
+begin
+if Assigned(Buff) then FreeMem(Buff, BuffSize);
+if Assigned(XP) then
+  FreeMem(XP);       
+Fonts.Free;
+Images.Free;
+FormControls.Free;
+SIndexList.Free;    
+Lines.Free;
+DefFont.Free;
+inherited Destroy;
+end;
+
+procedure TSection.DoClearAttribute(L: TAttributeList);
+var
+  T: TAttribute;
+  S: string[15];
+begin
+if L.Find(ClearSy, T) then
+  begin
+  S := LowerCase(T.Name);
+  if (S = 'left') then ClearAttr := clLeft
+  else if (S = 'right') then ClearAttr := clRight
+  else ClearAttr := clAll;
+  end;
+end;
+
+{----------------TSection.AddChar}
+procedure TSection.AddChar(C: char; Index: integer; NoBreak: boolean);
+var
+  Tok: TokenObj;
+begin
+Tok := TokenObj.Create;
+Tok.S := C;
+Tok.I^[1] := Index;
+AddTokenObj(Tok, NoBreak);
+Tok.Free;
+end;
+
+function TSection.GetIndexObj(I: integer): IndexObj;   
+begin
+Result := IndexObj(SIndexList[I]);
+end;
+
+procedure TSection.Finish;    
+{complete some things after all information added}
+var
+  Last, I: integer;
+  IO: IndexObj;
+begin
+if Len > 0 then
+  begin
+  Buff[Len] := #0;
+  if Assigned(XP) then  {XP = Nil when printing}
+    begin
+    Last := 0;   {to prevent warning msg}
+    SIndexList := TFreeList.Create;
+    for I := 0 to Len-1 do
+      begin
+      if (I = 0) or (XP^[I] <> Last+1) then
+        begin
+        IO := IndexObj.Create;
+        IO.Pos := I;
+        IO.Index := XP^[I];
+        SIndexList.Add(IO);
+        end;
+      Last := XP^[I];
+      end;
+    FreeMem(XP);
+    XP := Nil;     
+    end;
+  end;
+end;
+
+{----------------TSection.AddTokenObj}
+procedure TSection.AddTokenObj(S : TokenObj; NoBreak: boolean);
+var
+  L, I : integer;
+
+  Procedure Remove(I: integer);
+  begin
+  Move(S.I^[I+1], S.I^[I], ((Length(S.S))-I)*Sizeof(integer));
+  System.Delete(S.S, I, 1);
+  end;
+begin
+if Length(S.S) = 0 then Exit;
+{Delete leading spaces or multiple spaces}
+if not NoBreak then
+  begin
+  if ((Len = 0) or (Buff[Len-1] = ' ')) and (S.S[1] = ' ') then
+    begin
+    if Length(S.S) = 1 then Exit;
+    Remove(1);
+    end;
+  end
+else
+  begin
+  if ((Len = 0) or (Buff[Len-1] in [#5, #160, ' '])) and (S.S[1] = #5) then
+    begin
+    if Length(S.S) = 1 then Exit;
+    Remove(1)
+    end;
+  I := Pos(' '#5, S.S);
+  while I > 0 do
+    begin
+    Remove(I+1);
+    I := Pos(' '#5, S.S);
+    end;
+  I := Pos(#5#5, S.S);
+  while I > 0 do
+    begin
+    Remove(I);
+    I := Pos(#5#5, S.S);
+    end;
+  I := Pos(#5' ', S.S);
+  while I > 0 do
+    begin
+    Remove(I);
+    I := Pos(#5' ', S.S);
+    end;
+  I := Pos(#5, S.S);
+  while I > 0 do
+    begin
+    S.S[I] := #160;
+    I := Pos(#5, S.S);
+    end;
+  end;
+
+{After floating images at start, delete an annoying space}
+if Len > 0 then
+  for I := 0 to Len-1 do
+    begin
+    if (not (Buff[I] in [#4, #7])) or not (Images.FindImage(I).ObjAlign in [ALeft, ARight]) then 
+      Break;
+    if (I = Len-1) and (Length(S.S) > 0) and (S.S[1] in [' ', #160]) then  
+      begin
+      if Length(S.S) = 1 then Exit;
+      Remove(1)
+      end;
+    end;
+
+L := Len+Length(S.S);
+if BuffSize < L+1 then Allocate(L + 100);  {L+1 so there is always extra for font at end}
+Move(S.S[1], (Buff+Len)^, Length(S.S));
+Move(S.I[1], XP^[Len], Length(S.S)*Sizeof(integer));    
+Len := L;
+end;
+
+function TSection.BreakInfo(Index: integer; NoBreak: boolean): JustifyType;  {called when 
       encountered}
+begin
+Result := Justify;
+if Len = 0 then   {need to have at least one space}
+  begin
+  AddChar('X', Index, NoBreak);   {fool AddTokenObj into adding a leading space}
+  Buff[0] := ' ';
+  end;
+end;
+
+{----------------TSection.Allocate}
+procedure TSection.Allocate(N : integer);  
+begin
+if BuffSize < N then
+  begin
+  ReAllocMem(Buff, N);
+  ReAllocMem(XP, N*Sizeof(integer));
+  BuffSize := N;
+  end;
+end;
+
+procedure TSection.ChangeFont(List: TSectionList; NewFont: TMyFont);
+{will not accommodate a font size change}
+var
+  F: TMyFont;
+  FO: TFontObj;
+  LastUrl: TUrlTarget;
+begin
+FO := TFontObj(Fonts[Fonts.Count-1]);
+LastUrl := FO.UrlTarget;
+If FO.Pos = Len then
+  FO.TheFont.Assign(NewFont) {fontobj already at this position, modify it}
+else
+  begin
+  F := TMyFont.Create;
+  F.Assign(NewFont);
+  FO := TFontObj.Create(Self, F, Len);
+  Fonts.Add(FO);
+  if Assigned(LastUrl) then
+    FO.URLTarget.Assign(LastUrl.Url, LastUrl.Target);
+  end;
+with ThlParser(ParentSectionList.Parser) do   
+  begin
+  with FO.TheFont, (ParentSectionList.Parser as ThlParser) do
+    Style := Style + CurrentStyle; {add in , , etc}
+  FO.SScript := CurrentSScript;
+  if CurrentSScript in [SupSc, SubSc] then
+    FO.TheFont.SetNormalSize(List, MulDiv(FO.TheFont.NormalSize, 3, 4));
+  end;
+end;
+
+procedure TSection.ChangeStyle(Sy: Symb);
+var
+  Style: TFontStyles;
+  F: TMyFont;
+  FO: TFontObj;
+begin
+if Sy in [BSy, BEndSy, ISy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
+          USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy] then
+  begin
+  FO := TFontObj(Fonts[Fonts.Count-1]);
+  Style := FO.TheFont.Style;
+  case Sy of
+    BSy, StrongSy:  Style := Style + [fsBold];
+    BEndSy, StrongEndSy:  Style := Style - [fsBold];
+    ISy, EmSy, CiteSy, VarSy:  Style := Style + [fsItalic];
+    IEndSy, EmEndSy, CiteEndSy, VarEndSy:  Style := Style - [fsItalic];
+    USy:  Style := Style + [fsUnderline];
+    UEndSy:  Style := Style - [fsUnderline];
+    end;
+  If FO.Pos = Len then
+    FO.TheFont.Style := Style   {fontobj already at this position, modify it}
+  else
+    begin
+    F := TMyFont.Create;
+    F.Assign(FO.TheFont);   {just like the last one}
+    F.Style := Style;
+    FO := TFontObj.Create(Self, F, Len);
+    Fonts.Add(FO);
+    end;
+  end;
+end;
+
+procedure TSection.HRef(Sy: Symb; List: TSectionList; AnURL: TUrlTarget;
+          AFont: TMyFont);
+var
+  FO: TFontObj;
+begin
+ChangeFont(List, AFont);
+FO := TFontObj(Fonts[Fonts.Count-1]);
+FO.UrlTarget.Clear;
+if Sy = HRefSy then
+  begin
+  FO.UrlTarget.Assign(AnUrl.Url, AnUrl.Target);
+  List.LinkList.Add(FO);
+  end;
+end;
+
+function TSection.AddImage(L: TAttributeList; ACell: TCell; Index: integer; NoBreak: boolean): TImageObj; 
+begin
+Result := TImageObj.Create(Len, L);
+Result.MyCell := ACell;
+Images.Add(Result);
+if NoBreak then
+  AddChar(#7, Index, NoBreak)    {marker for nobreak image}
+else
+  AddChar(#4, Index, NoBreak);    {marker for image}
+end;
+
+{----------------TSection.AddFormControl}
+function TSection.AddFormControl(Which: Symb; AMasterList: TSectionList;
+         L: TAttributeList; ACell: TCell; Index: integer; NoBreak: boolean): TFormControlObj;
+var
+  T: TAttribute;
+  FCO: TFormControlObj;
+  S: string[20];
+  IO: TImageObj;
+
+  procedure GetEditFCO;
+  begin
+  FCO := TEditFormControlObj.Create(AMasterList, Len, L, S);
+  end;
+
+begin
+S := '';
+if Which = InputSy then
+  begin
+  if L.Find(TypeSy, T) then
+    begin
+    S := LowerCase(T.Name);
+    if (S = 'text') or (S = 'password') then
+      GetEditFCO
+    else if (S = 'submit') or (S = 'reset') or (S = 'button') then
+      FCO := TButtonFormControlObj.Create(AMasterList, Len, L, S)
+    else if S = 'radio' then
+      FCO := TRadioButtonFormControlObj.Create(AMasterList, Len, L, ACell)
+    else if S = 'checkbox' then
+      FCO := TCheckBoxFormControlObj.Create(AMasterList, Len, L)
+    else if S = 'hidden' then
+      FCO := THiddenFormControlObj.Create(AMasterList, Len, L)
+    else if S = 'image' then
+      FCO := TImageFormControlObj.Create(AMasterList, Len, L)
+    else
+      GetEditFCO;
+    end
+  else
+    GetEditFCO;
+  end
+else if Which = SelectSy then
+  begin
+  if L.Find(MultipleSy, T) or L.Find(SizeSy, T) and (T.Value > 1) then
+    FCO := TListBoxFormControlObj.Create(AMasterList, Len, L)
+  else
+    FCO := TComboFormControlObj.Create(AMasterList, Len, L);
+  end
+else
+  FCO := TTextAreaFormControlObj.Create(AMasterList, Len, L);
+if S = 'image' then
+  begin
+  IO := AddImage(L, ACell, Index, NoBreak);  {leave out of FormControlList} 
+  IO.MyFormControl := TImageFormControlObj(FCO);
+  end
+else if S <> 'hidden' then
+  begin
+  FormControls.Add(FCO);
+  if NoBreak then
+    AddChar(#6, Index, NoBreak)    {marker for no break FormControl}
+  else
+    AddChar(#2, Index, NoBreak);    {marker for FormControl}
+  end;
+Result := FCO;
+end;
+
+{----------------TSection.FindCountThatFits}
+function TSection.FindCountThatFits(Canvas: TCanvas; Width : integer;
+                Start : PChar; Max : integer) : integer;
+{Given a width, find the count of chars (<= Max) which will fit allowing for
+ font changes.  Line wrapping will be done later}
+var
+  Cnt, XX, I, J, J1, J2, J3, OHang, Tmp : integer;
+  Picture: boolean;
+  Align: AlignmentType;
+  HSpc: integer;  
+
+  function Find(Width, Max: integer; Start: PChar): integer;
+  {return count <= Max which fits in Width}
+  var
+    L, H, I, X: integer;
+    ExtS: TSize;
+  {$ifndef ver120_plus}
+    NilP: integer absolute 0;
+  {$endif}
+  begin
+  L := 0; H := Max-1;
+  while L <= H do
+    begin
+    I := (L+H) shr 1;
+{$ifdef ver120_plus}
+    GetTextExtentExPoint(Canvas.Handle, Start, I+1, 0, Nil, Nil, ExtS);
+{$else} {do Nil the hard way for Delphi 3}
+    GetTextExtentExPoint(Canvas.Handle, Start, I+1, 0, NilP, NilP, ExtS);
+{$endif}
+    x := ExtS.cx - OHang;
+    if X <= Width then
+      L := I+1
+    else H := I-1;
+    end;
+  Result := L;
+  end;
+
+begin
+Cnt := 0;
+XX := 0;
+while True do
+  begin
+  Canvas.Font := Fonts.GetFontAt(Start-Buff, OHang);
+  J1 := Fonts.GetFontCountAt(Start-Buff, Len);
+  J2 := Images.GetImageCountAt(Start-Buff);
+  J3 := TFormControlList(FormControls).GetControlCountAt(Start-Buff);
+  if J2 = 0 then
+    begin
+    Tmp:= Images.GetWidthAt(Start-Buff, Align, HSpc);
+    if not (Align in [ALeft, ARight]) then
+      XX := XX + Tmp + 2*HSpc;                  
+    I := 1;  J := 1;
+    Picture := True;
+    if XX > Width then break;  
+    end
+  else if J3 = 0 then
+    begin
+    XX := XX + TFormControlList(FormControls).GetWidthAt(Start-Buff);
+    I := 1;  J := 1;
+    Picture := True;
+    if XX > Width then break;   
+    end
+  else
+    begin
+    Picture := False;
+    J := IntMin(J1, J2);
+    J := IntMin(J, J3);
+    I := Find(Width-XX, J, Start);
+    end;
+  if Cnt+I >= Max then      {I has been initialized}
+    begin
+    Cnt := Max;
+    Break;
+    end
+  else Inc(Cnt, I);
+
+  if not Picture then
+    begin
+    if I < J then Break;
+    XX := XX + GetXExtent(Canvas.Handle, Start, I) - OHang;
+    end;
+
+  Inc(Start, I);
+  end;
+Result := Cnt;
+end;
+
+{----------------TSection.FindCountThatFits1}
+function TSection.FindCountThatFits1(Canvas: TCanvas; Width : integer;
+                Start : PChar; Max: integer; Y: integer; IMgr: IndentManager;
+                var ImgHt: integer; NxImages: TList) : integer;
+{Given a width, find the count of chars (<= Max) which will fit allowing for
+ font changes.  Line wrapping will be done later}
+var
+  Cnt, XX, I, J, J1, J2, J3, OHang, ImgWidth : integer;
+  Picture: boolean;
+  Align: AlignmentType;
+  ImageAtStart: boolean;
+  FlObj: TFloatingObj;
+  HSpc: integer;     
+
+  function Find(Width, Max: integer; Start: PChar): integer;
+  {return count <= Max which fits in Width}
+  var
+    L, H, I, X: integer;
+    ExtS: TSize;
+  {$ifndef ver120_plus}
+    NilP: integer absolute 0;
+  {$endif}
+  begin
+  L := 0; H := Max-1;
+  while L <= H do
+    begin
+    I := (L+H) shr 1;
+{$ifdef ver120_plus}
+    GetTextExtentExPoint(Canvas.Handle, Start, I+1, 0, Nil, Nil, ExtS);
+{$else} {do Nil the hard way for Delphi 3}
+    GetTextExtentExPoint(Canvas.Handle, Start, I+1, 0, NilP, NilP, ExtS);
+{$endif}
+    x := ExtS.cx - OHang;
+    if X <= Width then
+      L := I+1
+    else H := I-1;
+    end;
+  Result := L;
+  end;
+
+begin
+ImageAtStart := True;
+ImgHt := 0;
+Cnt := 0;
+XX := 0;
+while True do
+  begin
+  Canvas.Font := Fonts.GetFontAt(Start-Buff, OHang);
+  J1 := Fonts.GetFontCountAt(Start-Buff, Len);
+  J2 := Images.GetImageCountAt(Start-Buff);
+  J3 := TFormControlList(FormControls).GetControlCountAt(Start-Buff);
+  if J2 = 0 then
+    begin   {next is an image}
+    ImgWidth := Images.GetWidthAt(Start-Buff, Align, HSpc);
+    if Align in [ALeft, ARight] then
+      begin
+      FlObj := Images.FindImage(Start-Buff);
+      if ImageAtStart then
+        begin
+        IMgr.Update(Y, FlObj);
+        Inc(XX, ImgWidth + FlObj.HSpace);
+        ImgHt := IntMax(ImgHt, FlObj.ImageHeight + 2*FlObj.VSpace);    
+        end
+      else
+        NxImages.Add(FlObj);    {save it for the next line}
+      end
+    else
+      begin
+      Inc(XX, ImgWidth+2*HSpc);   
+      ImageAtStart := False;
+      end;
+    I := 1;  J := 1;
+    Picture := True;
+    if XX > Width then break;
+    end
+  else if J3 = 0 then
+    begin
+    XX := XX + TFormControlList(FormControls).GetWidthAt(Start-Buff);
+    I := 1;  J := 1;
+    Picture := True;
+    ImageAtStart := False;
+    if XX > Width then break;     
+    end
+  else
+    begin
+    Picture := False;
+    J := IntMin(J1, J2);
+    J := IntMin(J, J3);
+    I := Find(Width-XX, J, Start);
+    end;
+  if Cnt+I >= Max then     {I has been initialized}
+    begin
+    Cnt := Max;
+    Break;
+    end
+  else Inc(Cnt, I);
+
+  if not Picture then      {Picture has been initialized}
+    begin
+    if I < J then Break;    {J has been initialized}
+    XX := XX + GetXExtent(Canvas.Handle, Start, I) - OHang;
+    ImageAtStart := False;
+    end;
+
+  Inc(Start, I);
+  end;
+Result := Cnt;
+end;
+
+{----------------TSection.MinMaxWidth}
+procedure TSection.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer);
+{Min is the width the section would occupy when wrapped as tightly as possible.
+ Max, the width if no wrapping were used.}
+var
+  I, Indx, FloatMin: integer;
+  P, P1: PChar;
+  Obj: TObject;  
+
+begin
+Min := 0;
+Max := 0;
+if not Assigned(Buff) then Exit;
+
+for I := 0 to Images.Count-1 do     {call drawlogic for all the images}
+  begin
+  Obj := TObject(Images[I]);
+  if (Obj is TImageObj) then   
+    with TImageObj(Obj) do
+      begin
+      DrawLogic(Self.ParentSectionList, Canvas, Fonts.GetFontObjAt(Pos, Indx), 0);
+      if not PercentWidth then
+        if ObjAlign in [ALeft, ARight] then
+          Max := Max + ImageWidth + HSpace
+        else Min := IntMax(Min, ImageWidth);
+      end
+  else
+    with TFloatingObj(Obj) do        
+      if ObjAlign in [ALeft, ARight] then
+        Max := Max + ImageWidth + HSpace
+      else Min := IntMax(Min, ImageWidth);
+  end;
+FloatMin := Max;
+Max := FindTextWidth(Canvas, Buff, Len, False) + Indent + Max;
+
+Buff[Len] := #0;  {always extra space on end}
+P := Buff;
+while P^ = ' ' do Inc(P);
+P1 := P;
+while P^ <> #0 do
+  begin
+  while not (P1^ in [' ', #4, #0]) do Inc(P1);
+  Min := IntMax(Min, FindTextWidth(Canvas, P, P1-P, False));
+  while (P1^ in [' ', #4]) do Inc(P1);
+  P := P1;
+  end;
+Min := Min + FloatMin + Indent;
+end;
+
+{----------------TSection.FindTextWidth}
+function TSection.FindTextWidth(Canvas: TCanvas; Start: PChar; N: integer;
+                                        RemoveSpaces: boolean): integer;
+{find actual line width of N chars starting at Start.  If RemoveSpaces set,
+ don't count spaces on right end}
+var
+  I, J, J1, OHang, Wid, HSpc: integer;
+  Align: AlignmentType;
+begin
+Result := 0;
+if RemoveSpaces then
+  while ((Start+N-1)^ = ' ') and (N > 1) do
+    Dec(N);    {remove spaces on end}
+while N > 0 do
+  begin
+  J := Images.GetImageCountAt(Start-Buff);
+  J1 := TFormControlList(FormControls).GetControlCountAt(Start-Buff);
+  if J = 0 then  {it's and image}
+    begin
+    Wid := Images.GetWidthAt(Start-Buff, Align, HSpc);
+    {Here we count floating images as 1 char but do not include their width,
+      This is required for the call in FindCursor}
+    if not (Align in [ALeft, ARight]) then
+      begin
+      Result := Result + Wid + 2*HSpc;  
+      end;
+    Dec(N);   {image counts as one char}
+    Inc(Start);
+    end
+  else if J1 = 0 then
+    begin
+    Result := Result + TFormControlList(FormControls).GetWidthAt(Start-Buff);
+    Dec(N);   {control counts as one char}
+    Inc(Start);
+    end
+  else
+    begin
+    Canvas.Font := Fonts.GetFontAt(Start-Buff, OHang);
+    I := IntMin(J, J1);
+    I := IntMin(I, IntMin(Fonts.GetFontCountAt(Start-Buff, Len), N));
+    Inc(Result, GetXExtent(Canvas.Handle, Start, I) - OHang);
+    Dec(N, I);
+    Inc(Start, I);
+    end;
+  end;
+end;
+
+{----------------TSection.DrawLogic}
+function TSection.DrawLogic(Canvas : TCanvas; Y: integer; IMgr: IndentManager;
+             var MaxWidth: integer; var Curs: integer): integer;
+{returns height of the section}
+var
+  PStart, P, Last : PChar;
+  Max, N, Width, I, Indx, ImgHt: integer;
+  Finished: boolean;
+  LR : LineRec;
+  NxImages: TList;
+  Tmp: integer;
+  Obj: TFloatingObj;
+
+  function GetClearSpace: integer;
+  var
+    CL, CR: integer;
+  begin
+  Result := 0;
+  if (ClearAttr <> clrNone) then
+    begin  {may need to move down past floating image}
+    IMgr.GetClearY(CL, CR);
+    case ClearAttr of
+      clLeft:  Result := IntMax(0, CL-Y-1);
+      clRight:  Result := IntMax(0, CR-Y-1);
+      clAll: Result := IntMax(CL-Y-1, IntMax(0, CR-Y-1));
+      end;
+    end;
+  end;
+
+  procedure LineComplete(NN : integer);
+  var
+    I, J, DHt, Desc, Tmp, Cnt, Index, H, SB, SA : integer;
+    FP : TFontObj;
+    Align: AlignmentType;
+    BaseLine: boolean;
+    NoChar: boolean;   
+    P: PChar;
+    FCO: TFormControlObj;
+  begin
+  DHt := 0;    {for the fonts on this line get the maximum height}
+  Cnt := 0;
+  Desc := 0;    
+  NoChar := True;
+  P := PStart;
+  for I := 0 to NN-1 do
+    begin
+    if not (P^ in [#2, #4, #6, #7]) then
+      begin   {check for the no character case}
+      NoChar := False;
+      Break;
+      end;
+    Inc(P);
+    end;
+
+  if not NoChar then   
+    repeat
+      FP := Fonts.GetFontObjAt(PStart-Buff+Cnt, Index);
+      Tmp := FP.GetHeight(Desc);
+      DHt := IntMax(DHt, Tmp);  
+      LR.Descent := IntMax(LR.Descent, Desc);
+      J := Fonts.GetFontCountAt(PStart-Buff+Cnt, Len);
+      Inc(Cnt, J);
+    until Cnt >= NN;
+
+  Cnt := 0;   {if images, then maybe they add extra space}
+  SB := 0;
+  SA := 0;  {space before and after}
+  repeat
+    Cnt := Cnt + Images.GetImageCountAt(PStart-Buff+Cnt);
+    if Cnt < NN then
+      begin
+      H := Images.GetHeightAt(PStart-Buff+Cnt, Align);
+      case Align of
+        ATop: SA := IntMax(SA, H - DHt);
+        AMiddle:
+             begin
+             Tmp := (H - DHt) div 2;
+             SA := IntMax(SA, Tmp);
+             SB := IntMax(SB, (H - DHt - Tmp));
+             end;
+        ABottom: SB := IntMax(SB, H - (DHt - Desc));
+        end;
+      end;
+    Inc(Cnt);  {to skip by the image}
+  until Cnt >= NN;
+
+  Cnt := 0;   {now check on form controls}
+  repeat
+    Cnt := Cnt + TFormControlList(FormControls).GetControlCountAt(PStart-Buff+Cnt);
+    if Cnt < NN then
+      begin
+      H := TFormControlList(FormControls).GetHeightAt(PStart-Buff+Cnt, BaseLine);
+      if BaseLine then
+        SB := IntMax(SB, H-(DHt-Desc))
+      else
+        SB := IntMax(SB, H-DHt);
+      FCO := TFormControlList(FormControls).FindControl(PStart-Buff+Cnt);   
+      if Assigned(FCO) then
+        FCO.FYValue := Y;
+      end;
+    Inc(Cnt);  {to skip by the control}
+  until Cnt >= NN;
+
+  LR.Start := PStart;
+  LR.LineHt := DHt;
+  LR.Ln := NN;
+  Tmp := Imgr.LeftIndent(Y);
+  if Justify = Left then
+    LR.LineIndent := Tmp
+  else if Justify = Centered then
+    LR.LineIndent := IntMax(Tmp, (Tmp + IMgr.RightSide(Y)-(FindTextWidth(Canvas, PStart, NN, True))) div 2)  
+  else LR.LineIndent := (IMgr.RightSide(Y)-(FindTextWidth(Canvas, PStart, NN, True)))-1; 
+  LR.SpaceBefore := LR.SpaceBefore + SB;
+  LR.SpaceAfter := SA;
+  Lines.Add(LR);
+  Inc(PStart, NN);
+  SectionHeight := SectionHeight +DHt + SA + LR.SpaceBefore;
+  Tmp := DHt +SA + SB;
+  Inc(Y, Tmp);  
+  LR.LineImgHt := IntMax(Tmp, ImgHt);
+  for I := 0 to NxImages.Count-1 do
+    begin
+    IMgr.Update(Y, TFloatingObj(NxImages[I]));  {update Image manager and Image} 
+    {include images in Line height}
+    LR.LineImgHt := IntMax(LR.LineImgHt,         
+       Tmp+TFloatingObj(NxImages[I]).ImageHeight + 2*TFloatingObj(NxImages[I]).VSpace);
+    end;
+  NxImages.Clear;
+  end;
+
+begin
+YValue := Y;
+StartCurs := Curs;
+PStart := Buff;
+Last := Buff + Len - 1;
+SectionHeight := 0;
+Lines.Clear;
+if Indent = SmallListIndent then  
+  IMgr.SetLevelSmall(Y, Level)   {special case, 
    •  without 
        }
+else IMgr.SetLevel(Y, Level);
+if (Len = 0) then
+  begin
+  Result := GetClearSpace;
+  DrawHeight := Result;
+  SectionHeight := Result;
+  MaxWidth := 0;
+  Exit;
+  end;
+Finished := False;
+LevelIndent := Imgr.LeftIndent(Y);
+MaxWidth := IMgr.Width;
+Width := IMgr.RightSide(Y)-IMgr.LeftIndent(Y);
+for I := 0 to Images.Count-1 do     {call drawlogic for all the images}
+  begin   
+  Obj := TFloatingObj(Images[I]);
+  with Obj do
+    begin
+    if Obj is TImageObj then   
+      TImageObj(Obj).DrawLogic(Self.ParentSectionList, Canvas, Fonts.GetFontObjAt(Pos, Indx), Width);
+    MaxWidth := IntMax(MaxWidth, ImageWidth + Self.Indent);  {HScrollBar for wide images}
+    end;
+  end;
+for I := 0 to FormControls.Count-1 do
+  with TFormControlObj(FormControls[I]) do
+    if Assigned(FControl) then
+      MaxWidth := IntMax(MaxWidth, FControl.Width + Self.Indent);
+NxImages := TList.Create;
+while not Finished do
+  begin
+  Max := Last - PStart + 1;
+  if Max <= 0 then Break;
+  LR := LineRec.Create;     {a new line}
+  if (Lines.Count = 0) then
+    begin  {may need to move down past floating image}
+    Tmp := GetClearSpace;
+    if Tmp > 0 then
+      begin
+      LR.LineHt := Tmp;
+      Inc(SectionHeight, Tmp);
+      LR.Ln := 0;
+      LR.Start := PStart;
+      Inc(Y, Tmp);
+      Lines.Add(LR);
+      LR := LineRec.Create;
+      end;
+    end;
+
+  if Self is TPreformated then Width := 32000
+  else Width := IMgr.RightSide(Y)-IMgr.LeftIndent(Y);
+  N := IntMax(FindCountThatFits1(Canvas, Width, PStart, Max, Y, IMgr,
+              ImgHt, NxImages), 1); {N = at least 1}
+  if N = Max then
+    begin   {Do the remainder}
+    LineComplete(N);
+    Finished := True;
+    end
+  else
+    begin
+    P := PStart + N -1;
+    if (P^ = ' ') then
+      begin  {move past spaces so as not to print any on next line}
+      while (N < Max) and ((P+1)^ = ' ') do
+        begin
+        Inc(P);
+        Inc(N);
+        end;
+      LineComplete(N);
+      Finished := N >= Max;
+      end
+    else if (N < Max) and ((P+1)^ in [#2, #4]) then {an image or control}
+      begin
+      LineComplete(N);
+      Finished := False;
+      end
+    else
+      Begin  {non space, wrap it by backing off to previous space or image}
+      while not (P^ in [' ', #2, #4]) and (P > PStart) do Dec(P);
+      if P = PStart then
+        begin {no space found, forget the wrap, write the whole word and any
+               spaces found after it}
+        P := PStart+N-1;
+        while (P <> Last) and not ((P+1)^ in [' ', #2, #4]) do
+          begin
+          Inc(P);
+          end;
+        while (P <> Last) and ((P+1)^ = ' ') do
+          begin
+          Inc(P);
+          end;    
+        MaxWidth := IntMax(MaxWidth, FindTextWidth(Canvas, PStart, P-PStart+1, True));  
+        LineComplete(P-PStart+1);
+        Finished := P = Last;
+        end
+      else
+        begin  {found space}
+        LineComplete(P-PStart+1);
+        end;
+      end;
+    end;
+  end;
+NxImages.Free;
+Curs := StartCurs + Len;
+if Level > 0 then
+  {for lists, clear left floating images}
+  begin
+  Tmp := IMgr.GetLevelClear - YValue;
+  if Tmp > SectionHeight then SectionHeight := Tmp;
+  end;
+DrawHeight := IMgr.ImageBottom - YValue;  {in case image overhangs}
+if DrawHeight < SectionHeight then
+  DrawHeight := SectionHeight;        
+Result := SectionHeight;
+end;
+
+{----------------TSection.Draw}
+function TSection.Draw(Canvas: TCanvas; const ARect: TRect;
+     IMgr: IndentManager; X: integer; Y: integer) : integer;
+var
+  I: integer;
+  MySelB, MySelE: integer;
+  DC: HDC;
+  Ctrl: TFormControlObj;
+  YOffset: integer;
+
+  procedure DrawTheText(LR: LineRec; Start : PChar; Cnt, Descent: integer);
+  var
+    I, J, J1, J2, J3, J4, XX, OHang, Index, Addon, TopP, Tmp : integer;
+    Obj: TFloatingObj;
+    FO: TFontObj;
+    ARect: TRect;
+    Inverted, ImageAtStart: boolean;
+    S: string;
+
+    function ChkInversion(C : integer; var Count: Integer) : boolean;
+    var
+      LongCount: integer;
+    begin
+    Result := False;
+    Count := 32000;
+    if MySelE < MySelB then Exit;
+    if (MySelB <= C) and (MySelE > C) then
+      begin
+      Result := True;
+      LongCount := MySelE - C;
+      end
+    else if MySelB > C then LongCount := MySelB - C
+    else if (MySelB = C) and ParentSectionList.ShowDummyCaret then
+      LongCount := 1
+    else LongCount := 32000;
+    if LongCount > 32000 then Count := 32000
+      else Count := LongCount;
+    end;
+
+  begin  {Y is at bottom of line here}
+  ImageAtStart := True;
+  XX := X + LR.LineIndent;
+  LR.DrawY := Y-LR.LineHt;
+  LR.DrawX := XX;
+  while Cnt > 0 do
+    begin
+    I := 1;
+    J1 := Fonts.GetFontCountAt(Start-Buff, Len)-1;
+    J2 := Images.GetImageCountAt(Start-Buff)-1;
+    J4 := TFormControlList(FormControls).GetControlCountAt(Start-Buff)-1;
+    FO := Fonts.GetFontObjAt(Start-Buff, Index);
+    Canvas.Font := FO.TheFont;
+    OHang := FO.OverHang;
+    if J2 = -1 then
+      begin  {it's an image}
+      Obj := Images.FindImage(Start-Buff);
+      FO := Fonts.GetFontObjAt(Start-Buff, Index);
+      if Obj is TImageObj then
+        begin
+        if Obj.ObjAlign in [ALeft, ARight] then
+          begin
+          if ImageAtStart then
+            begin
+            TImageObj(Obj).Draw(Canvas, IMgr.LfEdge+Obj.Indent,
+                 Y-LR.LineHt-LR.SpaceBefore, Y-Descent, FO);
+            end
+          else
+            begin {if not at start, draw on next line}
+            TImageObj(Obj).Draw(Canvas, IMgr.LfEdge+Obj.Indent, Y, Y-Descent, FO);
+            end;
+          end
+        else
+          begin
+          TImageObj(Obj).Draw(Canvas, XX+Obj.HSpace, Y-LR.LineHt, Y-Descent, FO);
+          XX := XX + Obj.ImageWidth + 2*Obj.HSpace;
+          ImageAtStart := False;
+          end;
+        end;
+      end
+    else if J4 = -1 then
+      begin  {it's a form control}
+      Ctrl := TFormControlList(FormControls).FindControl(Start-Buff);
+      if Assigned(Ctrl.FControl) then
+        with Ctrl, FControl do
+          begin
+          ShowIt := True;
+          if BaseLine then
+            TopP := Y - Height - Descent -YOffset {sits on baseline}
+          else TopP := Y-Height-YOffset;
+          Show;
+          Left := XX;
+          Top := TopP;
+          if Ctrl is TRadioButtonFormControlObj then
+            with  TRadioButtonFormControlObj(Ctrl) do
+              begin
+              TRadioButtonFormControlObj(Ctrl).RButton.Show;
+              if MyCell.BkGnd then
+                (FControl as TPanel).Color := MyCell.BkColor
+              else (FControl as TPanel).Color := ParentSectionList.Background;
+              TRadioButtonFormControlObj(Ctrl).RButton.Repaint;
+              end;
+          Inc(XX, Width);
+          end;
+      ImageAtStart := False;
+      end
+    else
+      begin
+      J := IntMin(J1, J2);
+      J := IntMin(J, J4);
+      Inverted := ChkInversion(Start-Buff, J3);
+      J := IntMin(J, J3-1);
+      I := IntMin(Cnt, J+1);
+      if Inverted then
+        begin
+        SetBkMode(Canvas.Handle, Opaque);
+        Canvas.Brush.Color := Canvas.Font.Color;
+        Canvas.Font.Color := ParentSectionList.Background;
+        end
+      else
+        SetBkMode(Canvas.Handle, Transparent);
+
+      SetTextAlign(Canvas.Handle, TA_BaseLine);  {control and image upsets this}
+      SetLength(S, I);     
+      Move(Start^, S[1], I);  
+      J := Pos(#160, S);
+      while J > 0 do     {substitute spaces for #160}
+        begin
+        S[J] := ' ';
+        J := Pos(#160, S);
+        end;
+      if Self is TPreformated then
+        begin   {so will clip in Table cells}
+        ARect := Rect(X, Y-LR.LineHt-LR.SpaceBefore-YOffset, X+IMgr.ClipWidth, Y-YOffset+1);
+        ExtTextOut(Canvas.Handle, XX-OHang div 2, Y - Descent -YOffset, ETO_CLIPPED,
+               @ARect, PChar(S), I, Nil);
+        Addon := 0;
+        end
+      else
+        begin
+        with FO do
+          if SScript = Normal then Addon := 0
+            else if SScript = SupSc then Addon := -(FontHeight div 3)
+            else Addon := Descent div 2 +1;
+        TextOut(Canvas.Handle, XX-OHang div 2, Y - Descent + Addon - YOffset, PChar(S), I);
+        end;
+      {Put in a dummy caret to show character position}
+      if ParentSectionList.ShowDummyCaret and not Inverted
+                                  and (MySelB = Start-Buff) then
+        begin
+        Canvas.Pen.Color := Canvas.Font.Color;
+        Tmp := Y - Descent+ FO.Descent + Addon - YOffset;
+        Canvas.Rectangle(XX-Ohang, Tmp, XX-Ohang+1, Tmp-FO.FontHeight);
+        end;
+      XX := XX + GetXExtent(Canvas.Handle, Start, I)-OHang;
+      ImageAtStart := False;
+      end;
+    Dec(Cnt, I);
+    Inc(Start, I);
+    end;
+  end;
+
+  procedure DoDraw(I: integer);
+  const
+    MaxRoman = 20;
+    LowRoman: array[1..MaxRoman] of string[5] = ('i', 'ii', 'iii', 'iv', 'v', 'vi',
+       'vii', 'viii', 'ix', 'x', 'xi', 'xii', 'xiii', 'xiv', 'xv', 'xvi', 'xvii',
+       'xviii', 'xix', 'xx');
+    HighRoman: array[1..MaxRoman] of string[5] = ('I', 'II', 'III', 'IV', 'V', 'VI',
+       'VII', 'VIII', 'IX', 'X', 'XI', 'XII', 'XIII', 'XIV', 'XV', 'XVI', 'XVII',
+       'XVIII', 'XIX', 'XX');
+  var
+    NStr : string[7];
+    BkGnd, BkGnd1: TColor;
+    XS, AlphaNumb: integer;
+
+    procedure Circle(X, Y: integer);
+    var
+      Rad: integer;
+    begin
+    Rad := 5 div 2;
+    Canvas.Ellipse(X-Rad, Y-Rad, X+Rad+1, Y+Rad+1);
+    end;
+
+  begin
+  with LineRec(Lines[I]) do
+    begin
+    Inc(Y, LineHt+SpaceBefore);
+    XS := LevelIndent + X;
+    if (I = 0) and (ListType <> None) then
+      if ListType = Definition then  {definition list, do nothing}
+      else if ListType = Ordered then   {ordered list}
+        begin
+        AlphaNumb := IntMin(ListNumb-1, 25);
+        case TOListItem(Self).IndexType of
+          'a': NStr := chr(ord('a')+AlphaNumb);
+          'A': NStr := chr(ord('A')+AlphaNumb);
+          'i': NStr := LowRoman[IntMin(ListNumb, MaxRoman)];
+          'I': NStr := HighRoman[IntMin(ListNumb, MaxRoman)];
+          else NStr := IntToStr(ListNumb);
+          end;
+        Canvas.Font := DefFont;   {Fonts[0] may have been changed}
+        NStr := NStr+'.';
+        SetBkMode(DC, Transparent);
+        Canvas.TextOut(XS-5-Canvas.TextWidth(NStr), Y-Descent-YOffset, NStr);
+        end
+      else if (ListType = Unordered) and not TUListItem(Self).Plain then
+        with Canvas do
+          begin
+          BkGnd := ParentSectionList.Background;
+          BkGnd1 := BkGnd and $FFFFFF;
+          if (BkGnd = clBtnFace) or (BkGnd1 = clWhite)
+                or (BkGnd1 = clSilver) or
+                ((BkGnd = clWindow) and (GetSysColor(Color_Window) = $FFFFFF))then
+            case Level of
+              0,3: begin Brush.Color := clRed; Pen.Color := clRed; end;
+              1,4: begin Brush.Color := clNavy; Pen.Color := clNavy; end;
+              2,5: begin Brush.Color := clMaroon; Pen.Color := clMaroon; end;
+              end
+          else
+            begin
+            Pen.Color := ParentSectionList.FontColor;
+            Brush.Style := bsClear;
+            end;
+          Circle(XS-8, Y-(LineHt div 2) - YOffset);
+          Brush.Color := BkGnd;
+          Brush.Style := bsSolid;
+          Pen.Color := ParentSectionList.FontColor;
+          end;
+    DrawTheText(LineRec(Lines[I]), Start, Ln, Descent);
+    Inc(Y, SpaceAfter);
+    end;
+  end;
+
+begin
+Result := Y + SectionHeight;
+YOffset := ParentSectionList.YOff;
+
+if (Len > 0) and (Y-YOffset+DrawHeight >= ARect.Top) and (Y-YOffset < ARect.Bottom) then
+  begin
+  DC := Canvas.Handle;
+  SetTextAlign(DC, TA_BaseLine);
+
+  MySelB := ParentSectionList.SelB-StartCurs;
+  MySelE := ParentSectionList.SelE-StartCurs;
+  for I := 0 to Lines.Count-1 do
+    with LineRec(Lines[I]) do
+      if (Y-YOffset+LineImgHt >= ARect.Top) and (Y-YOffset < ARect.Bottom) then
+        DoDraw(I)
+      else  {do not completely draw extremely long paragraphs}
+        Inc(Y, SpaceBefore + LineHt + SpaceAfter);
+  end;
+end;
+
+{----------------TSection.CopyToClipboard}
+procedure TSection.CopyToClipboard;
+var
+  I, J, Strt, X1, X2: integer;
+  MySelB, MySelE: integer;
+begin
+MySelB := ParentSectionList.SelB - StartCurs;
+MySelE := ParentSectionList.SelE - StartCurs;
+for I := 0 to Lines.Count-1 do
+  with LineRec(Lines.Items[I]) do
+    begin
+    Strt := Start-Buff;
+    if (MySelE <= Strt) or (MySelB > Strt + Ln) then Continue;
+    if MySelB-Strt > 0 then X1 := MySelB-Strt
+      else X1 := 0;
+    if MySelE-Strt < Ln then X2 := MySelE - Strt    
+      else X2 := Ln;
+    if X1 = 0 then     {output any line indent}
+      for J := 0 to LineIndent div ListIndent -1 do
+        ParentSectionList.CB.AddText('   ', 3);
+    ParentSectionList.CB.AddText(Start+X1, X2-X1);
+    if X2 = Ln then ParentSectionList.CB.AddTextCR('', 0);
+    end;
+end;
+
+{----------------TSection.PtInObject}
+function TSection.PtInObject(X : integer; Y: integer; var Obj: TObject;
+         var IX, IY: integer): boolean;
+{Y is distance from start of section}
+begin
+Result := (Images.Count > 0) and Images.PtInObject(X, YValue+Y, Obj, IX, IY);
+end;
+
+{----------------TSection.GetURL}
+function TSection.GetURL(Canvas: TCanvas; X: integer; Y: integer;
+          var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj): boolean;
+{Y is distance from start of section}
+var
+  I, H, L, Index, Width, TotalHt, IX, IY, Posn: integer;
+  FO : TFontObj;
+  LR: LineRec;
+  IMap, UMap: boolean;
+  MapItem: TMapItem;
+  ImageObj: TImageObj;
+
+  function MakeCopy(UrlTarget: TUrlTarget): TUrlTarget;
+  begin
+  Result := TUrlTarget.Create;
+  Result.Assign(UrlTarget.Url, UrlTarget.Target);
+  end;
+
+begin
+Result := False;
+{First, check to see if in an image}
+if (Images.Count > 0) and
+    Images.PtInImage(X, YValue+Y, IX, IY, Posn, IMap, UMap, MapItem, ImageObj) then
+  begin
+  ParentSectionList.ActiveImage := ImageObj;
+  if Assigned(ImageObj.MyFormControl) then
+    begin
+    FormControl := ImageObj.MyFormControl;
+    Result := True;
+    FormControl.XTmp := IX;
+    FormControl.YTmp := IY;
+    end
+  else if UMap then
+    begin
+    if MapItem.GetURL(IX, IY, UrlTarg) then
+      Result := True;
+    end
+  else
+    begin
+    FO := Fonts.GetFontObjAt(Posn, Index);
+    if FO.UrlTarget.Url <> '' then
+      begin   {found an URL}
+      Result := True;
+      UrlTarg := MakeCopy(FO.UrlTarget);
+      ParentSectionList.ActiveLink := FO;
+      if IMap then
+        UrlTarg.Url := UrlTarg.Url + '?'+IntToStr(IX)+','+IntToStr(IY);
+      end;
+    end;
+  Exit;
+  end;
+
+I := 0;  H := 0;
+LR := Nil;
+with Lines do
+  begin
+  while I < Count do
+    begin
+    LR := LineRec(Lines[I]);
+    with LR do
+      TotalHt := LineHt+SpaceBefore+SpaceAfter;
+    if H+TotalHt > Y then Break;
+    Inc(H, TotalHt);
+    Inc(I);
+    end;
+  if I >= Count then Exit;
+  end;
+with LR do
+  begin
+  if X < DrawX then Exit;   {LR has been initialized}
+  Width := X - DrawX;
+  L := FindCountThatFits(Canvas, Width, Start, Ln);
+  if L >= Ln then Exit;
+  FO := Fonts.GetFontObjAt(L+(Start-Buff), Index);
+  if FO.UrlTarget.Url <> '' then
+    begin   {found an URL}
+    if not ((Start+L)^ in [#4, #7]) then   {an image here would be in HSpace area}
+      Result := True
+    else Exit;
+    UrlTarg := MakeCopy(FO.UrlTarget);
+    ParentSectionList.ActiveLink := FO;
+    end;
+  end;
+end;
+
+{----------------TSection.FindCursor}
+function TSection.FindCursor(Canvas: TCanvas; X: integer; Y: integer;
+         var XR: integer; var YR: integer; var CaretHt: integer;
+         var SCell: TObject; var Intext: boolean): integer;
+{Given an X, Y, find the character position and the resulting XR, YR position
+ for a caret along with its height, CaretHt.  Coordinates are relative to this
+ section}
+var
+  I, H, L, Width, TotalHt, L1, W, Delta: integer;
+  LR: LineRec;
+begin
+Result := -1;
+I := 0;  H := 0; L1 := 0;
+LR := Nil;
+with Lines do
+  begin
+  while I < Count do
+    begin
+    LR := LineRec(Lines[I]);
+    with LR do
+      TotalHt := LineHt+SpaceBefore+SpaceAfter;
+    if H+TotalHt > Y then Break;
+    Inc(H, TotalHt);
+    Inc(I);
+    Inc(L1, LR.Ln);  {L1 accumulates char count of previous lines}
+    end;
+  if I >= Count then Exit;
+  end;
+with LR do
+  begin
+  InText := True;   
+  CaretHt := LineHt;    {LR has been initialized}
+  YR := H + SpaceBefore;
+  if X < DrawX then
+    begin
+    Result := L1+StartCurs;
+    InText := False;   
+    Exit;
+    end;
+  Width := X-DrawX;
+  L := FindCountThatFits(Canvas, Width, Start, Ln);
+  W := FindTextWidth(Canvas, Start, L, False);
+  XR := DrawX + W;
+  if L < Ln then
+    begin   {check to see if passed 1/2 character mark}
+    Delta := FindTextWidth(Canvas, Start+L, 1, False);
+    if Width > W+(Delta div 2) then
+      begin
+      Inc(L);
+      Inc(XR, Delta);
+      end;
+    end
+  else InText := False;
+  Result := L+L1+StartCurs;
+  end;
+end;
+
+{----------------TSection.FindString}
+function TSection.FindString(From: integer; PC: PChar; MatchCase: boolean): integer;
+var
+  P: PChar;
+  I: integer;
+  LenPC: word;
+  UCh, LCh: Char;
+  S1, S2: string[255];
+
+  function ScanCaseless(P: PChar; LCh, UCh: Char): PChar;
+  {Ch is lower case here}
+  var
+    PU, PL: PChar;
+  begin
+  PU := StrScan(P, UCh);
+  PL := StrScan(P, LCh);
+  if not Assigned(PU) then Result := PL
+  else if not Assigned(PL) then Result := PU
+  else if (PU <= PL) then Result := PU
+  else Result := PL;
+  end;
+
+begin
+Result := -1;
+if (Len = 0) or (From >= StartCurs + Len) then Exit;
+if From < StartCurs then I := 0
+else I := From-StartCurs;
+
+if MatchCase then
+  begin    {case sensitive search}
+  P := StrPos(Buff + I, PC);
+  if Assigned(P) then
+    Result := StartCurs+(P-Buff);
+  end
+else
+  begin    {Caseless search}
+  UCh := PC^;
+  LCh := AnsiLowerCase(UCh)[1];   {make lower case}
+  UCh := AnsiUpperCase(LCh)[1];   {make upper case}
+  LenPC := IntMin(StrLen(PC), 255);
+  P := ScanCaseless(Buff + I, LCh, UCh);
+  S1 := StrPas(PC);
+  S2[0] := chr(LenPC);
+  while Assigned(P) and (StrLen(P) >= LenPC) do
+    begin
+    System.Move(P^, S2[1], LenPC);
+    if AnsiCompareText(S1, S2) = 0 then
+      begin
+      Result := StartCurs + (P-Buff);
+      Exit;
+      end;
+    Inc(P);
+    P := ScanCaseless(P, LCh, UCh);
+    end;
+  end;
+end;
+
+{----------------TSection.FindSourcePos}
+function TSection.FindSourcePos(DocPos: integer): integer;   
+var
+  I: integer;
+  IO: IndexObj;
+begin
+Result := -1;
+if (Len = 0) or (DocPos >= StartCurs + Len) then Exit;
+
+for I := SIndexList.Count-1 downto 0 do
+  begin
+  IO := PosIndex[I];
+  if IO.Pos <= DocPos-StartCurs then
+    begin
+    Result := IO.Index + DocPos-StartCurs - IO.Pos;
+    break;
+    end;
+  end;
+end;
+
+{----------------TSection.FindDocPos}
+function TSection.FindDocPos(SourcePos: integer; Prev: boolean): integer;
+{for a given Source position, find the nearest document position either Next or
+ previous}
+var
+  I: integer;
+  IO, IOPrev: IndexObj;
+begin
+Result := -1;
+if Len = 0 then Exit;
+
+if not Prev then
+  begin
+  I:= SIndexList.Count-1;
+  IO := PosIndex[I];
+  if SourcePos > IO.Index + (Len-1) - IO.Pos then Exit; {beyond this section}
+
+  IOPrev := PosIndex[0];
+  if SourcePos <= IOPrev.Index then
+    begin  //in this section but before the start of Document text
+    Result := StartCurs;
+    Exit;
+    end;
+
+  for I := 1 to SIndexList.Count-1 do
+    begin
+    IO := PosIndex[I];
+    if (SourcePos >= IOPrev.Index) and (SourcePos < IO.Index) then
+      begin //between IOprev and IO
+      if SourcePos-IOPrev.Index+IOPrev.Pos < IO.Pos then
+        Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index)
+      else Result := StartCurs+IO.Pos;
+      Exit;
+      end;
+    IOPrev := IO;
+    end;
+  //after the last IndexObj in list
+  Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index);
+  end
+else     //prev  -- we're iterating from the end of TSectionList
+  begin
+  IOPrev := PosIndex[0];
+  if SourcePos < IOPrev.Index then Exit;   //before this section
+
+  I:= SIndexList.Count-1;
+  IO := PosIndex[I];
+  if SourcePos > IO.Index + (Len-1) - IO.Pos then
+    begin   //SourcePos is after the end of this section
+    Result := StartCurs + (Len-1);
+    Exit;
+    end;
+
+  for I := 1 to SIndexList.Count-1 do
+    begin
+    IO := PosIndex[I];
+    if (SourcePos >= IOPrev.Index) and (SourcePos < IO.Index) then
+      begin //between IOprev and IO
+      if SourcePos-IOPrev.Index+IOPrev.Pos < IO.Pos then
+        Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index)
+      else Result := StartCurs+IO.Pos-1;
+      Exit;
+      end;
+    IOPrev := IO;
+    end;
+  //after the last IndexObj in list
+  Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index);
+  end;
+end;
+
+{----------------TSection.CursorToXY}
+function TSection.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
+             var Y: integer): boolean;
+var
+  I, Curs: integer;
+  LR: LineRec;
+begin
+Result := False;
+if (Len = 0) or (Cursor > StartCurs + Len) then Exit;
+
+I := 0;
+LR := Nil;
+Curs := Cursor - StartCurs;
+Y := YValue;
+with Lines do
+  begin
+  while I < Count do
+    begin
+    LR := LineRec(Lines[I]);
+    with LR do
+      begin
+      if Curs < Ln then Break;
+      Inc(Y, LineHt+SpaceBefore+SpaceAfter);
+      Dec(Curs, Ln);
+      end;
+    Inc(I);
+    end;
+  if I >= Count then Exit;
+  end;
+X := LR.DrawX + FindTextWidth(Canvas, LR.Start, Curs, False);
+Result := True;
+end;
+
+{----------------TSection.GetChAtPos}
+function TSection.GetChAtPos(Pos: integer; var Ch: char; var Obj: TObject): boolean;
+begin
+Result := False;
+if (Len = 0) or (Pos < StartCurs) or (Pos >= StartCurs + Len) then Exit;
+Ch := Buff[Pos-StartCurs];
+Obj := Self;
+Result := True;
+end;
+
+procedure TSection.UpdateFonts;
+begin
+Fonts.UpdateFonts;
+DefFont.UpdateFont(ParentSectionList, ParentSectionList.FontColor);
+inherited UpdateFonts;
+end;
+
+end.
+
+
+
diff --git a/components/htmllite/liteun2.pas b/components/htmllite/liteun2.pas
new file mode 100644
index 0000000000..39399ea67b
--- /dev/null
+++ b/components/htmllite/liteun2.pas
@@ -0,0 +1,2194 @@
+{Version 7.5}
+{*********************************************************}
+{*                     LITEUN2.PAS                       *}
+{*              Copyright (c) 1995-2002 by               *}
+{*                   L. David Baldwin                    *}
+{*                 All rights reserved.                  *}
+{*********************************************************}
+
+{$i LiteCons.inc}
+
+unit LiteUn2;
+
+interface
+uses
+  {$IFDEF HL_LAZARUS}
+  LCLLinux, LCLType, VCLGlobals, SysUtils, Messages, Classes, GraphType,
+  Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;
+  {$ELSE}
+  Windows, SysUtils, Messages, Classes, Graphics, Controls,
+  Forms, Dialogs, StdCtrls, ExtCtrls;
+  {$ENDIF}
+
+const
+  VersionNo = '7.5';
+  HandCursor = 1;
+  ThickIBeamCursor = 2;
+  UpDownCursor = 3;   
+  UpOnlyCursor = 4;
+  DownOnlyCursor = 5;
+  Tokenleng = 300;
+  TopLim = -200;
+  BotLim = 3000;
+
+type
+  TScriptEvent = procedure(Sender: TObject; const Name, Language: string;
+       Script: PChar) of Object;
+
+  TFreeList = class(TList)
+  {like a TList but frees it's items.  Use only descendents of TObject}
+    destructor Destroy; override;
+    {$Warnings Off}
+    procedure Clear;       {do not override}
+    end;
+    {$Warnings On}
+
+  Transparency = (NotTransp, LLCorner, TGif, TPng);
+  JustifyType = (NoJustify, Left, Centered, Right);
+  AlignmentType = (ATop, AMiddle, ABottom, ALeft, ARight); 
+
+  Symb = (
+    HtmlSy, TitleSy, BodySy, HeadSy, PSy, PEndSy, BSy, BEndSy, ISy, IEndSy,
+    HtmlEndSy, TitleEndSy, BodyEndSy, HeadEndSy, BRSy, HeadingSy, HeadingEndSy,
+    EmSy, EmEndSy, StrongSy, StrongEndSy, USy, UEndSy, HRSy,
+    CiteSy, VarSy, CiteEndSy, VarEndSy, BaseSy,
+       {Keep order}
+    TTSy, CodeSy, KbdSy, SampSy,  TTEndSy, CodeEndSy, KbdEndSy, SampEndSy,
+       {end order}
+    OLSy, OLEndSy, LISy, ULSy, ULEndSy, DirSy, DirEndSy, MenuSy, MenuEndSy,
+    DLSy, DLEndSy, DDSy, DTSy, AddressSy, AddressEndSy, BlockQuoteSy, BlockQuoteEndSy,
+    PreSy, PreEndSy, ImageSy, Centersy, CenterEndSy,
+    OtherAttribute, ASy, AEndSy, HrefSy, NameSy, SrcSy, AltSy, AlignSy,
+    OtherChar, OtherSy, CommandSy, TextSy, EofSy, LinkSy, BGColorSy,
+    BackgroundSy, TableSy, TableEndSy, TDSy, TDEndSy, TRSy, TREndSy, THSy, THEndSy,
+    ColSpanSy, RowSpanSy, BorderSy, CellPaddingSy, CellSpacingSy, VAlignSy,
+    WidthSy, CaptionSy, CaptionEndSy, StartSy, ButtonSy, InputSy, ValueSy,
+    TypeSy, CheckBoxSy, RadioSy, FormSy, FormEndSy, MethodSy, ActionSy,
+    CheckedSy, SizeSy, MaxLengthSy, TextAreaSy, TextAreaEndSy, ColsSy,
+    RowsSy, SelectSy, SelectEndSy, OptionSy, OptionEndSy, SelectedSy,
+    MultipleSy, FontSy, FontEndSy, ColorSy, FaceSy, BaseFontSy,
+    TranspSy, SubSy, SubEndSy, SupSy, SupEndSy, ClearSy, IsMapSy,
+    BigSy, BigEndSy, SmallSy, SmallEndSy, BorderColorSy, MapSy, MapEndSy,
+    AreaSy, ShapeSy, CoordsSy, NoHrefSy, UseMapSy, HeightSy, PlainSy,
+    FrameSetSy, FrameSetEndSy, FrameSy, TargetSy, NoFramesSy, NoFramesEndSy,
+    NoResizeSy, ScrollingSy, HSpaceSy, VSpaceSy, ScriptSy, ScriptEndSy,  
+    LanguageSy, DivSy, DivEndSy, SSy, SEndSy, StrikeSy, StrikeEndSy,
+    FrameBorderSy, MarginWidthSy, MarginHeightSy, BgSoundSy, LoopSy,
+    OnClickSy, WrapSy, NoShadeSy, MetaSy, HttpEqSy, ContentSy, EncTypeSy,
+    VLinkSy, OLinkSy, ActiveSy, NoBrSy, NoBrEndSy, WbrSy,
+    NoWrapSy, EolSy);   
+
+  TAttribute = class(TObject)  {holds a tag attribute}
+  public
+    Which: Symb;     {symbol of attribute such as HrefSy}
+    Value: integer;  {numeric value if appropriate}
+    Percent: boolean;{if value is in percent}
+    Name: String;   {String (mixed case), value after '=' sign}
+    constructor Create(ASym: Symb; AValue: integer; Const AString: String);
+    destructor Destroy; override;
+  end;
+
+  TAttributeList = class(TFreeList)  {a list of tag attributes,(TAttributes)}
+    public
+      function Find(Sy: Symb; var T: TAttribute): boolean;
+    end;
+
+  TBitmapItem = class(TObject)
+  public
+    AccessCount: integer;
+    UsageCount: integer;     {how many in use}
+    Transp: Transparency;    {identifies what the mask is for}
+    MImage: TPersistent;     {main image, bitmap or animated GIF}
+    Mask: TBitmap;  {its mask}
+    constructor Create(AImage: TPersistent; AMask: TBitmap; Tr: Transparency);
+    destructor Destroy; override;
+  end;
+
+  TStringBitmapList = class(TStringList)
+      {a list of bitmap filenames and TBitmapItems}
+  public
+    MaxCache: integer;
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear; override;
+    function AddObject(const S: string; AObject: TObject): Integer; override;
+    procedure DecUsage(const S: string);
+    procedure IncUsage(const S: string);  
+    procedure BumpAndCheck;
+    procedure PurgeCache;
+    function GetImage(I: integer): TPersistent;
+    procedure SetCacheCount(N: integer);
+  end;
+
+  SelTextCount = class(TObject)
+    Buffer: PChar;
+    BufferLeng: integer;
+    Leng: integer;
+    procedure AddText(P: PChar; Size: integer); virtual;
+    procedure AddTextCR(P: PChar; Size: integer);
+    function Terminate: integer; virtual;
+    end;
+
+  SelTextBuf = class(SelTextCount)      
+    constructor Create(ABuffer: PChar; Size: integer);
+    procedure AddText(P: PChar; Size: integer); override;
+    function Terminate: integer; override;
+    end;
+
+  TUrlTarget = Class(TObject)
+    URL,
+    Target: String;
+    constructor Create;
+    destructor Destroy; override;
+    procedure Assign(AnUrl, ATarget: String);
+    procedure Clear;
+    end;
+
+  TMapItem = class(TObject)   {holds a client map info}
+    MapName: String;
+    Areas: TStringList;       {holds the URL and region handle}
+    AreaTargets: TStringList; {holds the target window}
+    constructor Create;
+    destructor Destroy; override;
+    function GetURL(X, Y: integer; var URLTarg: TURLTarget): boolean;
+    procedure AddArea(Attrib: TAttributeList);
+    end;
+
+  TDib = class(TObject)
+    private
+      Info  : PBitmapInfoHeader;
+      InfoSize: integer;
+      Image: Pointer;
+      ImageSize : integer;
+      FHandle: THandle;
+      procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP);
+      procedure GetDIBX(DC: HDC; Bitmap: HBITMAP; Palette: HPALETTE);
+      procedure Allocate(Size: integer);
+      procedure DeAllocate;
+    public
+      constructor CreateDIB(DC: HDC; Bitmap: TBitmap);
+      destructor Destroy; override;
+      function CreateDIBmp: hBitmap;
+      procedure DrawDIB(DC: HDC; X: Integer; Y: integer; W, H: integer; ROP: DWord);
+    end;
+
+  IndentRec = Class(TObject)
+    X: integer;       {indent for this record}
+    YT, YB: integer;  {top and bottom Y values for this record}
+    Lev: integer;     {list level for this record, 0 for not applicable}
+    end;
+
+  IndentManagerBasic = class(TObject)
+    Width, ClipWidth: Integer;
+    L, R: TFreeList;  {holds info (IndentRec's) on left and right indents}
+    CurrentLevel: integer;       {the current list level}
+    LfEdge, RtEdge: integer;     {current extreme edges}
+
+    constructor Create;
+    destructor Destroy; override;
+    procedure Clear;
+    procedure Reset(Lf, Rt: integer);
+    procedure UpdateTable(Y: integer; IW: integer; IH: integer; Justify: JustifyType);
+    function LeftIndent(Y: integer): integer;
+    function RightSide(Y: integer): integer;
+    function ImageBottom: integer;
+    procedure GetClearY(var CL, CR: integer);
+    procedure SetLevel(Y: integer; Level: integer);
+    procedure SetLevelSmall(Y: integer; Level: integer);  
+    function GetLevelClear: integer;
+    end;
+
+  AllocRec = Class(TObject)
+    Ptr: Pointer;
+    ASize: integer;
+    AHandle: THandle;
+    end;
+
+  IndexArray = array[1..TokenLeng] of integer;
+  PIndexArray = ^IndexArray;
+  TokenObj= class
+    S: string;
+    I: ^IndexArray;
+    MaxIndex: integer;
+    constructor Create;
+    destructor Destroy; override;
+    procedure AddChar(C: char; Ind: integer);
+    procedure Concat(T: TokenObj);
+    procedure Clear;
+    end;
+
+  ImageType = (NoImage, Bmp, Gif, Gif89, Png, Jpg);
+
+var
+  ColorBits: Byte;
+  ThePalette: HPalette;       {the rainbow palette for 256 colors}
+  DefBitMap, ErrorBitMap, ErrorBitmapMask: TBitMap;
+  BitmapList: TStringBitmapList; {the image cache}
+  WaitStream: TMemoryStream;  
+
+type
+  {$IFDEF HL_LAZARUS}HLString{$ELSE}OpenString{$ENDIF} = String;
+
+Function IntMin(A, B : Integer) : Integer;
+Function IntMax(A, B : Integer) : Integer;
+
+function GetImageFromFile(const Filename: String): TBitmap;
+function GetImageAndMaskFromFile(const Filename: String; var Transparent: Transparency;
+                            var Mask: TBitmap): TBitmap;
+function HTMLToDos(FName: string): string;
+  {convert an HTML style filename to one for Dos}
+function HTMLServerToDos(FName, Root: string): string;
+function Trim(S : String) : String;
+{Trims leading and trailing spaces and control chars from string}
+
+procedure WrapText(Canvas: TCanvas; X1, Y1, X2, Y2: integer; S: string);
+
+procedure FinishTransparentBitmap (ahdc: HDC;
+            InImage, Mask: TBitmap; xStart, yStart, W, H: integer);  
+function GetImageMask(Image: TBitmap; ColorValid: boolean; AColor: TColor): TBitmap;
+function TransparentGIF(const FName: string; var Color: TColor): boolean;
+function Allocate(Size: integer): AllocRec;
+procedure DeAllocate(AR: AllocRec);
+function CopyPalette(Source: hPalette): hPalette;
+procedure SetGlobalPalette(Value: HPalette);
+function GetImageAndMaskFromStream(Stream: TMemoryStream;
+        var Transparent: Transparency; var Mask: TBitmap): TBitmap;
+function KindOfImage(Start: Pointer): ImageType;
+procedure FormControlRect(Canvas: TCanvas; X1: integer;
+           Y1: integer; X2: integer; Y2: integer; Raised: boolean);
+function GetXExtent(DC: HDC; P: PChar; N: integer): integer;
+function IsTransparent(Stream: TStream; var Color: TColor): boolean;
+procedure RaisedRect(SectionList: TFreeList; Canvas: TCanvas; X1: integer;
+           Y1: integer; X2: integer; Y2: integer; Raised: boolean);
+
+{$ifndef Ver130}
+{$ifndef Delphi6_Plus}
+procedure FreeAndNil(var Obj);
+{$endif}
+{$endif}
+
+implementation
+
+uses
+  {$IFDEF HL_LAZARUS}
+  HTMLLite, LiteSubs, LiteDith, LiteGif2;
+  {$ELSE not HL_LAZARUS}
+  {$ifdef ver100_plus}
+     jpeg, LiteDith,
+  {$endif}
+     htmllite, LiteSubs, LiteGif2;
+  {$ENDIF not HL_LAZARUS}
+
+  {$ifdef ver100_plus}
+  {$IFNDEF HL_LAZARUS}
+type                            
+  TJpegMod = class(TJpegImage)
+  public
+    property Bitmap;
+  end;
+  {$ENDIF not HL_LAZARUS}
+  {$endif}
+
+var
+  DC: HDC;
+
+Function IntMin(A, B : Integer) : Integer;
+begin
+  if A < B then Result := A
+  else Result := B
+end;
+
+Function IntMax(A, B : Integer) : Integer;
+begin
+  if A > B then Result := A
+  else Result := B;
+end;
+
+{$ifndef Ver130}
+{$ifndef Delphi6_Plus}
+procedure FreeAndNil(var Obj);
+var
+  P: TObject;
+begin
+  P := TObject(Obj);
+  TObject(Obj) := nil;  {clear the reference before destroying the object}
+  P.Free;
+end;
+{$endif}
+{$endif}
+
+function HTMLServerToDos(FName, Root: string): string;
+begin
+Result := HTMLToDos(FName);
+if (Length(Result) >= 1) and (Result[1] = '\') then
+  Result := Root+Result;
+end;
+
+function HTMLToDos(FName: string): string;
+{convert an HTML style filename to one for Dos}
+var
+  I: integer;
+
+  procedure Replace(Old, New: char);
+  var
+    I: integer;
+  begin
+  I := Pos(Old, FName);
+  while I > 0 do
+    begin
+    FName[I] := New;
+    I := Pos(Old, FName);
+    end;
+  end;
+
+  procedure ReplaceEscapeChars;  
+  var
+    S: string[3];
+    I: integer;
+  begin
+  I := Pos('%', FName);
+  while (I > 1) and (I <= Length(FName)-2) do
+    begin
+    S := '$'+FName[I+1]+FName[I+2];
+    try
+      FName[I] := chr(StrToInt(S));
+      Delete(FName, I+1, 2);
+    except   {ignore exception}
+      Exit;
+      end;
+    I := Pos('%', FName);
+    end;
+  end;
+
+begin
+ReplaceEscapeChars;
+I := pos('/', FName);
+if I <> 0 then
+  begin
+  I := Pos('file:///', Lowercase(FName));
+  if I > 0 then
+    System.Delete(FName, I, 8)
+  else
+    begin
+    I := Pos('file://', Lowercase(FName));
+    if I > 0 then System.Delete(FName, I, 7);
+    end;
+  Replace('|', ':');
+  Replace('/', '\');
+  end;
+Result := FName;
+end;
+
+function Trim(S : String) : String;
+{Trims leading and trailing spaces and control chars from string}
+var
+  I, Len : Integer;
+begin
+while (Length(S) > 0) and (S[Length(S)] <= ' ') do  SetLength(S, Length(S)-1);
+if Length(S) > 0 then
+  begin
+  I := 1;
+  while S[I] <= ' ' do Inc(I);
+  if I>1 then
+    begin
+    Len := Length(S) -I+1;
+    Move(S[I], S[1], Len);
+    SetLength(S, Len);
+    end;
+  end;
+Trim := S;
+end;
+
+procedure WrapText(Canvas: TCanvas; X1, Y1, X2, Y2: integer; S: string);
+{Wraps text in a clipping rectangle. Font must be set on entry}
+var
+  S1, S2: string;
+  I, Y, Width, Step: integer;
+  ARect: TRect;
+  SaveStyle: TBrushStyle;
+begin
+with Canvas do
+  begin
+  SaveStyle := Brush.Style;  
+  Brush.Style := bsClear;   
+  ARect := Rect(X1, Y1, X2, Y2);
+  Width := X2 - X1;                                
+  Y := Y1;
+  Step := TextHeight('A');
+  SetTextAlign(Canvas.Handle, TA_Top);
+  S1 := '';
+  while (Length(S) > 0) and (Y+Step <= Y2) do
+    begin
+    S := Trim(S);   {in case of extra spaces}
+    I := Pos(' ', S);
+    if I > 0 then
+      begin
+      S2 := Copy(S, 1, I-1);
+      Delete(S, 1, I);
+      end
+    else
+      Begin
+      S2 := S;
+      S := '';
+      end;
+    if TextWidth(S1+S2) <= Width then
+      begin
+      S1 := S1+S2+' ';
+      end
+    else
+      begin
+      if S1 <> '' then
+        begin
+        TextRect(ARect, X1, Y, S1);
+        Inc(Y, Step);
+        end;
+      S1 := S2+' ';
+      end;
+    end;
+  if (S1 <> '') and (Y+Step <= Y2) then
+    TextRect(ARect, X1, Y, S1);
+  Brush.Style := SaveStyle;
+  end;
+end;
+
+function Allocate(Size: integer): AllocRec;
+begin
+Result := AllocRec.Create;
+with Result do
+  begin
+  ASize := Size;
+  {$IFDEF HL_LAZARUS}
+  GetMem(Ptr, Size);
+  AHandle:=0;
+  {$ELSE}
+  if Size < $FF00 then
+    GetMem(Ptr, Size)
+  else
+     begin
+     AHandle := GlobalAlloc(HeapAllocFlags, Size);
+     if AHandle = 0 then
+         ABort;
+     Ptr := GlobalLock(AHandle);
+     end;
+  {$ENDIF}
+  end;
+end;
+
+procedure DeAllocate(AR: AllocRec);
+begin
+with AR do
+  {$IFDEF HL_LAZARUS}
+  Freemem(Ptr, ASize);
+  {$ELSE}
+  if ASize < $FF00 then
+    Freemem(Ptr, ASize)
+  else
+    begin
+    GlobalUnlock(AHandle);
+    GlobalFree(AHandle);
+    end;
+  {$ENDIF}
+AR.Free;
+end;
+
+function GetXExtent(DC: HDC; P: PChar; N: integer): integer;
+var
+  ExtS: TSize;
+ {$ifndef ver120_plus}
+   NilP: integer absolute 0;
+ {$endif}
+begin
+{$ifdef ver120_plus}
+  GetTextExtentExPoint(DC, P, N, 0, Nil, Nil, ExtS);
+{$else} {do Nil the hard way for Delphi 3}
+  GetTextExtentExPoint(DC, P, N, 0, NilP, NilP, ExtS);
+{$endif}
+Result := ExtS.cx;
+end;
+
+procedure FormControlRect(Canvas: TCanvas; X1: integer;
+           Y1: integer; X2: integer; Y2: integer; Raised: boolean);
+{Draws lowered rectangles for form control printing}
+var
+  OldStyle: TPenStyle;
+  OldWid: integer;
+  OldBrushStyle: TBrushStyle;
+  OldBrushColor: TColor;
+  Mono: boolean;
+begin
+with Canvas do
+  begin
+  Mono := (GetDeviceCaps(Handle, BITSPIXEL) = 1) and
+          (GetDeviceCaps(Handle, PLANES) = 1);
+  Dec(X2);  Dec(Y2);
+  OldWid := Pen.Width;
+  OldStyle := Pen.Style;
+  OldBrushStyle := Brush.Style;   {save style first}
+  OldBrushColor := Brush.Color;
+  Brush.Color := clWhite;
+  Brush.Style := bsSolid;
+  FillRect(Rect(X1, Y1, X2, Y2));
+  Brush.Color := OldBrushColor;
+  Brush.Style := OldBrushStyle;    {style after color as color changes style}
+
+  Pen.Style := psInsideFrame;
+  if Mono then
+    begin
+    Pen.Width := 1;
+    Pen.Color := clBlack;
+    end
+  else
+    begin
+    Pen.Width := 2;
+    if Raised then Pen.Color := clSilver
+      else Pen.Color := clBtnShadow;
+    end;
+  MoveTo(X1, Y2);
+  LineTo(X1, Y1);
+  LineTo(X2, Y1);
+  if not Mono then
+    if Raised then Pen.Color := clBtnShadow
+      else Pen.Color := clSilver;
+  LineTo(X2, Y2);
+  LineTo(X1, Y2);
+  Pen.Style := OldStyle;
+  Pen.Width := OldWid;
+  end;
+end;
+
+procedure RaisedRect(SectionList: TFreeList; Canvas: TCanvas; X1: integer;
+           Y1: integer; X2: integer; Y2: integer; Raised: boolean);
+{Draws raised or lowered rectangles for table borders}
+var
+  White, BlackBorder: boolean;
+begin
+Y1 := IntMax(Y1, TopLim);
+Y2 := IntMin(Y2, BotLim);
+with Canvas do
+  begin
+  with SectionList as TSectionList do
+    begin
+    White := ((Background and $FFFFFF = clWhite) or
+        ((Background = clWindow) and (GetSysColor(Color_Window) = $FFFFFF)));  
+    BlackBorder := False;
+    end;
+  if BlackBorder then
+    Pen.Color := clBlack
+  else if Raised then
+    if White then
+      Pen.Color := clSilver
+    else Pen.Color := clBtnHighLight
+  else Pen.Color := clBtnShadow;
+
+  MoveTo(X1, Y2);
+  LineTo(X1, Y1);
+  LineTo(X2, Y1);
+  if BlackBorder then        
+    Pen.Color := clBlack
+  else if not Raised then
+    if White then
+      Pen.Color := clSilver
+    else Pen.Color := clBtnHighLight
+  else Pen.Color := clBtnShadow;
+  LineTo(X2, Y2);
+  LineTo(X1, Y2);
+  end;
+end;
+
+{$ifdef Ver90}  
+procedure Assert(B: boolean; const S: string);
+begin   {dummy Assert for Delphi 2}
+end;
+{$endif}
+
+destructor TFreeList.Destroy;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  TObject(Items[I]).Free;
+inherited Destroy;
+end;
+
+procedure TFreeList.Clear;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  TObject(Items[I]).Free;
+inherited Clear;
+end;
+
+constructor TBitmapItem.Create(AImage:TPersistent; AMask: TBitmap; Tr: Transparency);
+begin
+inherited Create;
+MImage := AImage;
+Mask := AMask;
+AccessCount := 0;
+Transp := Tr;
+end;
+
+destructor TBitmapItem.Destroy;
+begin
+Assert(UsageCount = 0, 'Freeing Image still in use'); 
+MImage.Free;
+Mask.Free;
+inherited Destroy;
+end;
+
+constructor TStringBitmapList.Create;
+begin
+inherited Create;
+MaxCache := 4;
+end;
+
+destructor TStringBitmapList.Destroy;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  (Objects[I] as TBitmapItem).Free;
+inherited Destroy;
+end;
+
+function TStringBitmapList.AddObject(const S: string; AObject: TObject): Integer;
+begin
+Result := inherited AddObject(S, AObject);
+if AObject is TBitmapItem then
+  Inc(TBitmapItem(AObject).UsageCount);
+end;
+
+procedure TStringBitmapList.DecUsage(const S: string);
+var
+  I: integer;
+begin
+I := IndexOf(S);
+if I >= 0 then
+  with Objects[I] as TBitmapItem do
+    begin
+    Dec(UsageCount);
+    Assert(UsageCount >= 0, 'Cache image usage count < 0');  
+    end;
+end;
+
+procedure TStringBitmapList.IncUsage(const S: string);
+var
+  I: integer;
+begin
+I := IndexOf(S);
+if I >= 0 then
+  with Objects[I] as TBitmapItem do
+    Inc(UsageCount);
+end;
+
+procedure TStringBitmapList.SetCacheCount(N: integer);
+var
+  I: integer;
+begin
+for I := Count-1 downto 0 do
+  with (Objects[I] as TBitmapItem)do
+    begin
+    if (AccessCount > N) and (UsageCount <= 0) then     
+      begin
+      Delete(I);
+      Free;
+      end;
+    end;
+MaxCache := N;
+end;
+
+function TStringBitmapList.GetImage(I: integer): TPersistent;
+begin
+with Objects[I] as TBitmapItem do
+  begin
+  Result := MImage;
+  AccessCount := 0;
+  Inc(UsageCount);
+  end;
+end;
+
+procedure TStringBitmapList.BumpAndCheck;
+var
+  I: integer;
+  Tmp: TBitmapItem;
+begin
+  for I := Count-1 downto 0 do
+    begin
+    Tmp := (Objects[I] as TBitmapItem);
+    with Tmp do
+      begin
+      Inc(AccessCount);
+      if (AccessCount > MaxCache) and (UsageCount <= 0) then
+        begin
+        Delete(I);
+        Free;          {the TBitmapItem}
+        end;
+      end;
+    end;
+end;
+
+procedure TStringBitmapList.PurgeCache;
+var
+  I: integer;
+  Tmp: TBitmapItem;
+begin
+for I := Count-1 downto 0 do
+  begin
+  Tmp := (Objects[I] as TBitmapItem);
+  with Tmp do
+    begin
+    if (UsageCount <= 0) then
+      begin
+      Delete(I);
+      Free;          {the TBitmapItem}
+      end;
+    end;
+  end;
+end;
+
+procedure TStringBitmapList.Clear;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  (Objects[I] as TBitmapItem).Free;
+inherited Clear;
+end;
+
+constructor TAttribute.Create(ASym: Symb; AValue: integer; Const AString: String);
+begin
+inherited Create;
+Which := ASym;
+Value := AValue;
+Name := AString;
+end;
+
+destructor TAttribute.Destroy;
+begin
+inherited Destroy;
+end;
+
+{----------------TAttributeList.Find}
+function TAttributeList.Find(Sy: Symb; var T: TAttribute): boolean;
+var
+  I: integer;
+begin
+for I := 0 to Count-1 do
+  if TAttribute(Items[I]).which = Sy then
+    begin
+    Result := True;
+    T := TAttribute(Items[I]);
+    Exit;
+    end;
+Result := False;
+end;
+
+{----------------TUrlTarget.Create}
+constructor TUrlTarget.Create;
+begin
+inherited Create;
+end;
+
+destructor TUrlTarget.Destroy;
+begin
+inherited Destroy;
+end;
+
+procedure TUrlTarget.Assign(AnUrl, ATarget: String);
+begin
+Url := AnUrl;
+Target := ATarget;
+end;
+
+procedure TUrlTarget.Clear;
+begin
+Url := '';
+Target := '';
+end;
+
+{----------------SelTextCount}
+procedure SelTextCount.AddText(P: PChar; Size: integer);    
+var
+  I: integer;
+begin
+for I := 0 to Size-1 do
+  if not (P[I] in [#2, #4]) then {#4 and #2 used to mark images, form controls}
+    Inc(Leng);
+end;
+
+procedure SelTextCount.AddTextCR(P: PChar; Size: integer);
+begin
+AddText(P, Size);
+AddText(^M^J, 2);
+end;
+
+function SelTextCount.Terminate: integer;
+begin
+Result := Leng;  
+end;
+
+{----------------SelTextBuf.Create}
+constructor SelTextBuf.Create(ABuffer: PChar; Size: integer); 
+begin
+inherited Create;
+Buffer := ABuffer;
+BufferLeng := Size;
+end;
+
+procedure SelTextBuf.AddText(P: PChar; Size: integer);    
+var
+  SizeM1 : integer;
+  I: integer;
+begin
+SizeM1 := BufferLeng-1;
+for I := 0 to Size-1 do
+  if not (P[I] in [#2, #4]) then {#4 and #2 used to mark images, form controls}
+    if Leng < SizeM1 then
+      begin
+      if P[I] = #160 then
+        Buffer[Leng] := ' '
+      else Buffer[Leng] := P[I];
+      Inc(Leng);
+      end;
+end;
+
+function SelTextBuf.Terminate: integer;
+begin
+Buffer[Leng] := #0;
+Result := Leng+1;
+end;
+
+{----------------TMapItem.Create}
+constructor TMapItem.Create;
+begin
+inherited Create;
+Areas := TStringList.Create;
+AreaTargets := TStringList.Create;
+end;
+
+destructor TMapItem.Destroy;
+var
+  I: integer;
+begin
+for I := 0 to Areas.Count-1 do
+  DeleteObject(THandle(Areas.Objects[I]));
+Areas.Free;
+AreaTargets.Free;
+inherited Destroy;
+end;
+
+function TMapItem.GetURL(X, Y: integer; var URLTarg: TUrlTarget): boolean;
+var
+  I: integer;
+begin
+Result := False;
+with Areas do
+  for I := 0 to Count-1 do
+    if PtInRegion(THandle(Objects[I]), X, Y) then
+      begin
+      if Strings[I] <> '' then  {could be NoHRef}    
+        begin
+        URLTarg := TUrlTarget.Create;
+        URLTarg.URL := Strings[I];
+        URLTarg.Target := AreaTargets[I];
+        Result := True;
+        end;
+      Exit;
+      end;
+end;
+
+procedure TMapItem.AddArea(Attrib: TAttributeList);
+Const
+  MAXCNT = 300;  
+var
+  I, Cnt, Rad: integer;
+  HRef, S, Target: string;
+  S1, Nm: string[20];
+  Coords: array[0..MAXCNT] of integer;
+  Rect: TRect absolute Coords;
+  Handle: THandle;
+  Shape: (Rec, Circle, Poly);
+
+  procedure GetSubStr;    
+  var
+    J,K: integer;
+  begin
+  J := Pos(',', S);
+  K := Pos(' ', S);   {for non comma situations (bad syntax)}
+  if (J > 0) and ((K = 0) or (K > J)) then
+    begin
+    S1 := copy(S, 1, J-1);
+    Delete(S, 1, J);
+    end
+  else if K > 0 then
+    begin
+    S1 := copy(S, 1, K-1);
+    Delete(S, 1, K);
+    end
+  else
+    begin
+    S1 := Trim(S);
+    S := '';
+    end;
+  while (Length(S) > 0) and ((S[1]=',') or (S[1]=' ')) do
+    Delete(S, 1, 1);
+  end;
+
+begin
+HRef := '';
+Target := '';
+Shape := Rec;
+Cnt := 0;
+Handle := 0;
+for I := 0 to Attrib.Count-1 do
+  with TAttribute(Attrib[I]) do
+    case Which of
+      HRefSy:  HRef := Name;
+      TargetSy:  Target := Name;
+      NoHrefSy: HRef := '';
+      CoordsSy:
+        begin
+        S := Trim(Name);
+        Cnt := 0;
+        GetSubStr;
+        while (S1 <> '') and (Cnt <= MAXCNT) do
+          begin
+          Coords[Cnt] := StrToIntDef(S1, 0);
+          GetSubStr;
+          Inc(Cnt);
+          end;
+        end;
+      ShapeSy:
+        begin
+        Nm := copy(Lowercase(Name),1, 4);
+        if Nm = 'circ' then Shape := Circle
+        else if (Nm = 'poly') then Shape := Poly;
+        end;
+      end;
+case Shape of
+  Rec:
+    begin
+    if Cnt < 4 then Exit;
+    Inc(Coords[2]);
+    Inc(Coords[3]);
+    Handle := CreateRectRgnIndirect(Rect);
+    end;
+  Circle:
+    begin
+    if Cnt < 3 then Exit;
+    Rad := Coords[2];
+    Dec(Coords[0],Rad);
+    Dec(Coords[1],Rad);
+    Coords[2] := Coords[0] + 2*Rad +1;
+    Coords[3] := Coords[1] + 2*Rad +1;
+    Handle := CreateEllipticRgnIndirect(Rect);
+    end;
+  Poly:
+    begin
+    if Cnt < 6 then Exit;
+    Handle := CreatePolygonRgn(PPoint(@Coords[Low(Coords)]), Cnt div 2, Winding);
+    end;
+  end;
+if Handle <> 0 then
+  begin
+  Areas.AddObject(HRef, TObject(Handle));
+  AreaTargets.Add(Target);
+  end;
+end;
+
+function KindOfImage(Start: Pointer): ImageType;
+type
+  ByteArray = array[0..10] of byte;
+var
+  PB: ^ByteArray absolute Start;
+  PW: ^Word absolute Start;
+  PL: ^DWord absolute Start;     
+begin
+if PL^ = $38464947 then
+  begin
+  if PB^[4] = Ord('9') then Result := Gif89
+  else Result := Gif;
+  end
+else if PW^ = $4D42 then Result := Bmp
+else if PL^ = $474E5089 then Result := Png
+else if PL^ = $E0FFD8FF then Result := Jpg    
+else Result := NoImage;
+end;
+
+function KindOfImageFile(const FName: string): ImageType;
+var
+  Stream: TFileStream;
+  Ar: Array[0..10] of byte;
+begin
+{Result := NoImage;}                      
+Stream := TFileStream.Create(FName, fmShareDenyWrite or FmOpenRead);
+try
+  Stream.Read(Ar, Sizeof(Ar));
+  Result := KindOfImage(@Ar);
+finally
+  Stream.Free;
+  end;
+end;
+
+{$IFNDEF HL_LAZARUS}
+{$A-} {record field alignment off for this routine}
+{$ENDIF}
+
+function IsTransparent(Stream: TStream; var Color: TColor): boolean;
+{Makes some simplifying assumptions that seem to be generally true for single
+ images.}
+Type
+  RGB = record
+    Red, Green, Blue: byte;
+    end;
+
+  GifHeader = record
+    GIF: array[0..2] of char;
+    Version: array[0..2] of char;
+    ScreenWidth, ScreenHeight: Word;
+    Field: Byte;
+    BackGroundColorIndex: byte;
+    AspectRatio: byte;
+    end;
+  ColorArray = array[0..255] of RGB;
+
+var
+  Header: ^GifHeader;
+  X: integer;
+  Colors: ^ColorArray;
+  Buff: array[0..Sizeof(GifHeader)+Sizeof(ColorArray)+8] of byte;
+  P: PChar;
+  OldPosition: integer;
+
+begin
+Result := False;
+Fillchar(Buff, Sizeof(Buff), 0);  {in case read comes short}
+OldPosition := Stream.Position;
+Stream.Position := 0;
+Stream.Read(Buff, Sizeof(Buff));
+Stream.Position := OldPosition;
+
+Header := @Buff;
+if KindOfImage(Header) <> Gif89 then Exit; 
+Colors := @Buff[Sizeof(GifHeader)];
+with Header^ do
+  begin
+  X := 1 shl ((Field and 7) +1) - 1;  {X is last item in color table}
+  if X = 0 then Exit;   {no main color table}
+  end;
+P := PChar(Colors)+(X+1)*Sizeof(RGB);
+if (P^ <> #$21) or ((P+1)^ <> #$F9) then Exit;  {extension block not found}
+if (ord(P[3]) and 1 <> 1) then Exit;     {no transparent color specified}
+
+with Colors^[Ord(P[6])] do
+  Color := integer(Blue) shl 16 or integer(Green) shl 8 or integer(Red);
+Result := True;
+end;
+
+{$IFNDEF HL_LAZARUS}
+{$A+}
+
+{$A-} {record field alignment off for this routine}
+{$ENDIF}
+
+function IsTransparentPng(Stream: TStream; var Color: TColor): boolean;
+Type
+  RGB = record
+    Red, Green, Blue: byte;
+    end;
+
+  PngHeader = record
+    width       : integer;
+    height      : integer;
+    bitDepth    : byte;
+    colorType   : byte;
+    compression : byte;
+    filter      : byte;
+    interlace   : byte;
+    end;
+var
+  Header: PngHeader;
+  CRC: integer;
+  OldPosition: integer;
+  pngPalette: array[0..255] of RGB;
+  dataSize : integer;
+  chunkType: array[0..4] of Char;
+  chunkTypeStr: string;
+  done : Boolean;
+  Ar: Array[0..10] of byte;
+
+  function IntSwap(data: integer): integer;
+  var
+     byte0 : integer;
+     byte1 : integer;
+     byte2 : integer;
+     byte3 : integer;
+  begin
+     byte0 := data and $FF;
+     byte1 := (data shr 8) and $FF;
+     byte2 := (data shr 16) and $FF;
+     byte3 := (data shr 24) and $FF;
+
+     result := (byte0 shl 24) or (byte1 shl 16) or (byte2 shl 8) or byte3;
+  end;
+
+begin
+result := false;
+OldPosition := Stream.Position;
+
+try
+   Stream.Position := 0;
+   Stream.Read(Ar, 8);
+
+   if KindOfImage(@Ar) <> Png then
+     begin
+     Stream.Position := OldPosition;
+     Exit;
+     end;
+
+   Stream.Position := 8; {past the PNG Signature}
+   done := False;
+
+{Read Chunks}
+   repeat
+      Stream.Read(dataSize, 4);
+      dataSize := IntSwap(dataSize);
+      Stream.Read(chunkType, 4);
+      chunkType[4] := #0; {make sure string is NULL terminated}
+      chunkTypeStr := StrPas(chunkType);
+      if chunkTypeStr = 'IHDR' then
+      begin
+         Stream.Read(Header, DataSize);
+         Header.width := IntSwap(Header.width);
+         Header.height := IntSwap(Header.height);
+         Stream.Read(CRC, 4); {read it in case we need to read more}
+         if (Header.colorType < 2) or (Header.colorType > 3) then
+            done := True; {only type 2 and 3 use tRNS}
+      end
+      else if chunkTypeStr = 'PLTE' then
+      begin
+         Stream.Read(pngPalette, DataSize);
+         Stream.Read(CRC, 4); {read it in case we need to read more}
+      end
+      else if chunkTypeStr =  'tRNS' then
+      begin
+         if Header.colorType = 3 then
+         begin
+            with pngPalette[dataSize - 1] do
+               Color := integer(Blue) shl 16 or integer(Green) shl 8 or integer(Red);
+         end
+         else  {has to have been 2}
+         begin
+            {for now I am ignoring this since I can't make one}
+         end;
+         result := true;
+         done := true; {got everything we need at this point}
+      end
+      else if chunkTypeStr = 'IDAT' then
+         done := True {if this chunk is hit there is no tRNS}
+      else
+         Stream.Position := Stream.Position + dataSize + 4; {additional 4 for the CRC}
+   until done = True;
+except
+   end;
+
+Stream.Position := OldPosition;
+end;
+
+{$IFNDEF HL_LAZARUS}
+{$A+}
+{$ENDIF}
+
+function TransparentGIF(const FName: string; var Color: TColor): boolean;
+{Looks at a GIF image file to see if it's a transparent GIF.}
+var
+  Stream: TFileStream;
+begin
+Result := False;
+try
+  Stream := TFileStream.Create(FName, fmShareDenyWrite or FmOpenRead);
+  try
+    Result := IsTransparent(Stream, Color);
+  finally
+    Stream.Free;
+  end;
+except
+  end;
+end;
+
+function TransparentPNG(const FName: string; var Color: TColor): boolean;
+{Looks at a PNG image file to see if it's transparent.}
+var
+  Stream: TFileStream;
+begin
+Result := False;
+try
+  Stream := TFileStream.Create(FName, fmShareDenyWrite or FmOpenRead);
+  try
+    Result := IsTransparentPng(Stream, Color);
+  finally
+    Stream.Free;
+  end;
+except
+  end;
+end;
+
+function ConvertImage(Bitmap: TBitmap): TBitmap;
+{convert bitmap into a form for BitBlt later}
+
+  function DIBConvert: TBitmap;
+  var
+    DC: HDC;
+    DIB: TDib;
+    OldBmp: HBitmap;
+    OldPal: HPalette;
+    Hnd: HBitmap;
+  begin
+  DC := CreateCompatibleDC(0);
+  OldBmp := SelectObject(DC, Bitmap.Handle);
+  OldPal := SelectPalette(DC, ThePalette, False);
+  RealizePalette(DC);
+  DIB := TDib.CreateDIB(DC, Bitmap);
+  Hnd := DIB.CreateDIBmp;
+  DIB.Free;
+  SelectPalette(DC, OldPal, False);
+  SelectObject(DC, OldBmp);
+  DeleteDC(DC);
+  Bitmap.Free;
+  Result := TBitmap.Create;
+  Result.Handle := Hnd;
+  if Result.Palette = 0 then
+    Result.Palette := CopyPalette(ThePalette);
+  end;
+
+begin
+if not Assigned(Bitmap) then
+  begin
+  Result := Nil;
+  Exit;
+  end;
+
+{$ifndef ver100_plus}  {Delphis 1 and 2}
+if ColorBits > 8 then
+  begin
+  Result := Bitmap;
+  Exit;
+  end;
+Result := DIBConvert;
+Exit;
+{$endif}
+
+{Remainder is for Delphis >= 3 or C++Builder >= 3}
+
+{$ifdef ver100_plus}
+
+if ColorBits > 8 then
+  begin
+  if Bitmap.PixelFormat <= pf8bit then    
+    Result := DIBConvert
+  else
+    Result := Bitmap;
+  Exit;
+  end;
+
+if Bitmap.HandleType = bmDIB then
+  begin
+  Result := GetBitmap(Bitmap);
+  Bitmap.Free;
+  Exit;
+  end;
+Result := DIBConvert;
+{$endif}
+end;
+
+function GetImageFromFileInternal(const Filename: String; Convert: boolean): TBitmap;
+var
+  IT: ImageType;
+  {$ifdef ver100_plus}
+  {$IFNDEF HL_LAZARUS}
+  jpImage: TJpegMod;
+  {$ENDIF}
+  {$endif}
+
+  function GetGif(var Rslt: TBitmap): boolean;  
+  var
+    TmpGif: TGifImage;
+    NonAnimated: boolean;
+  begin
+  Result := False;
+  TmpGif := CreateAGif(Filename, NonAnimated);
+  if Assigned(TmpGif) then
+    begin
+    if NonAnimated then Convert := False;
+    Rslt.Assign(TmpGif.Bitmap);
+    TmpGif.Free;
+    Result := True;
+    end
+  end;
+
+begin
+try
+  Result := TBitmap.Create;
+  try
+    IT := KindOfImageFile(Filename);
+
+      if IT = Bmp then
+        Result.LoadFromFile(Filename)
+      else if (IT in [Gif, Gif89]) and GetGif(Result) then
+      {$ifdef ver100_plus}
+      {$IFNDEF HL_LAZARUS}
+      else if IT = Jpg then
+         begin
+         jpImage := TJpegMod.Create;
+         try
+           try
+             jpImage.LoadFromFile(Filename);
+             if ColorBits <= 8 then
+               begin
+               jpImage.PixelFormat := jf8bit;
+               if not jpImage.GrayScale then
+                 jpImage.Palette := CopyPalette(ThePalette);
+               end
+             else jpImage.PixelFormat := jf24bit;
+             Result.Assign(jpImage.Bitmap);
+           finally
+             jpImage.Free;
+             end;
+         except
+           Result.Free;
+           Result := Nil;
+           end;
+         end
+      {$endif not HL_LAZARUS}
+      {$endif}
+      else begin Result.Free; Result := Nil; Exit; end;
+    if Convert then
+      Result := ConvertImage(Result);
+  except
+    Result.Free;
+    Result := Nil;
+  end;
+except
+  Result := Nil;
+  end;
+end;
+
+function GetImageFromFile(const Filename: String): TBitmap;
+begin
+Result := GetImageFromFileInternal(Filename, True);
+end;
+
+function GetImageAndMaskFromFile(const Filename: String; var Transparent: Transparency;
+                            var Mask: TBitmap): TBitmap;
+var
+  Color: TColor;
+  TmpBmp: TBitmap;
+  Ext: string[10];
+begin
+Result := Nil;
+if not FileExists(Filename) then Exit;
+Ext := LowerCase(ExtractFileExt(Filename));
+{$ifndef NoGIF}
+if (Ext = '.gif') and TransparentGIF(Filename, Color) then
+  Transparent := TGif;
+{$endif}
+if (Ext = '.png') and TransparentPng(Filename, Color) then
+  Transparent := TPng;
+Mask := Nil;
+if Transparent = NotTransp then
+  Result := GetImageFromFile(Filename)
+else
+  begin
+  TmpBmp := GetImageFromFileInternal(Filename, False);
+  if Assigned(TmpBmp) then
+    try
+      case Transparent of
+        {$ifndef NoGIF}
+        TGif, Tpng: Mask := GetImageMask(TmpBmp, True, Color);
+        {$else}
+        Tpng: Mask := GetImageMask(TmpBmp, True, Color);
+        {$endif}
+        LLCorner: Mask := GetImageMask(TmpBmp, False, 0);
+        end;
+      if Assigned(Mask) then
+        Result := GetImageFromFile(Filename);  {the dithered image}
+    finally
+      TmpBmp.Free;
+      end;
+  end;
+end;
+
+function GetImageAndMaskFromStream(Stream: TMemoryStream;
+        var Transparent: Transparency; var Mask: TBitmap): TBitmap;
+var
+  IT: ImageType;
+{$ifdef ver100_plus}
+  {$IFNDEF HL_LAZARUS}
+  jpImage: TJpegMod;
+  {$ENDIF}
+{$endif}
+begin
+Result := Nil;
+Mask := Nil;
+if not Assigned(Stream) or (Stream.Memory = Nil) or (Stream.Size < 20) then
+  Exit;
+Stream.Position := 0;
+IT := KindOfImage(Stream.Memory);
+if not (IT in [Bmp, Jpg]) then
+  Exit;
+Result := TBitmap.Create;
+try
+  {$ifdef ver100_plus}
+  {$IFDEF HL_LAZARUS}
+  Result.LoadFromStream(Stream);
+  {$ELSE}
+  if IT = Jpg then
+    begin
+    Transparent := NotTransp;
+    jpImage := TJpegMod.Create;
+    try
+      jpImage.LoadFromStream(Stream);
+      if ColorBits <= 8 then
+        begin
+        jpImage.PixelFormat := jf8bit;
+        if not jpImage.GrayScale then
+          jpImage.Palette := CopyPalette(ThePalette);
+        end
+      else jpImage.PixelFormat := jf24bit;
+      Result.Assign(jpImage.Bitmap);
+    finally
+      jpImage.Free;
+      end;
+    end
+  else
+    Result.LoadFromStream(Stream);
+  {$else}
+  Result.LoadFromStream(Stream);
+  {$endif}
+  {$ENDIF not HL_LAZARUS}
+  if Transparent = LLCorner then
+    Mask := GetImageMask(Result, False, 0);
+  Result := ConvertImage(Result);
+except
+  Result.Free;
+  Result := Nil;
+  end;
+end;
+
+function GetImageMask(Image: TBitmap; ColorValid: boolean; AColor: TColor): TBitmap;
+var
+  TransparentColor: TColor;
+  cColor          : TColorRef;
+  bmAndObject,
+  bmObjectOld     : HBitmap;
+  hdcObject,
+  hdcTemp,
+  DC              : HDC;
+  ptSize          : TPoint;
+  Pal: HPalette;
+begin
+DC := GetDC(0);
+
+if ColorValid then
+  TransparentColor := AColor  {color has already been selected}
+else
+  {set the transparent color to be the lower left pixel of the bitmap}
+  TransparentColor := Image.Canvas.Pixels[0, Image.Height - 1];
+
+TransparentColor := TransparentColor or $02000000;
+
+hdcTemp := CreateCompatibleDC(DC);
+SelectObject (hdcTemp, Image.Handle); { select the bitmap }
+
+{ convert bitmap dimensions from device to logical points}
+ptSize.x := Image.Width;
+ptSize.y := Image.Height;
+DPtoLP (hdcTemp, ptSize, 1);  { convert from device logical points }
+
+{ create some DCs to hold temporary data}
+hdcObject := CreateCompatibleDC(DC);
+
+{ create a bitmap for each DC}
+{ monochrome DC}
+bmAndObject := CreateBitmap (ptSize.x, ptSize.y, 1, 1, nil);
+
+{ each DC must select a bitmap object to store pixel data}
+bmObjectOld := SelectObject (hdcObject, bmAndObject);
+
+{ set proper mapping mode}
+SetMapMode (hdcTemp, GetMapMode(DC));
+
+{ set the background color of the source DC to the color.
+  contained in the parts of the bitmap that should be transparent}
+Pal := Image.Palette;
+SelectPalette(hdcTemp, Pal, False);
+RealizePalette(hdcTemp);
+cColor := SetBkColor (hdcTemp, TransparentColor);
+
+{ create the object mask for the bitmap by performing a BitBlt()
+  from the source bitmap to a monochrome bitmap}
+BitBlt (hdcObject, 0, 0, ptSize.x, ptSize.y, hdcTemp, 0, 0, SRCCOPY);
+
+{ set the background color of the source DC back to the original color}
+SetBkColor (hdcTemp, cColor);
+
+{Save the Object bitmap}
+try
+  Result := TBitmap.Create;
+  try
+    Result.Handle := bmAndObject;
+  except
+    Result.Free;
+    Raise;
+  end;
+except
+  Result := Nil;
+end;
+
+{ delete the memory bitmaps}
+SelectObject (hdcObject, bmObjectOld);
+
+{ delete the memory DCs}
+DeleteDC (hdcObject);
+DeleteDC (hdcTemp);
+ReleaseDC(0, DC);
+end;
+
+{----------------FinishTransparentBitmap }
+procedure FinishTransparentBitmap (ahdc: HDC;
+              InImage, Mask: TBitmap; xStart, yStart, W, H: integer);   
+var
+  bmAndBack,
+  bmSave,
+  bmBackOld,
+  bmObjectOld : HBitmap;
+  hdcInvMask,
+  hdcMask,
+  hdcImage: HDC;
+  DestSize, SrcSize : TPoint;
+  OldBack, OldFore: TColor;
+  BM: tagBITMAP;
+  Image: TBitmap;
+
+begin
+Image := TBitmap.Create;  {protect original image} 
+try
+  Image.Assign(InImage);
+
+  hdcImage := CreateCompatibleDC (ahdc);
+  SelectObject (hdcImage, Image.Handle); { select the bitmap }
+
+  { convert bitmap dimensions from device to logical points}
+  SrcSize.x := Image.Width;
+  SrcSize.y := Image.Height;
+  DPtoLP(hdcImage, SrcSize, 1);
+
+  DestSize.x := W;
+  DestSize.y := H;
+  DPtoLP (hdcImage, DestSize, 1);
+
+  { create a bitmap for each DC}
+  { monochrome DC}
+  bmAndBack := CreateBitmap (SrcSize.x, SrcSize.y, 1, 1, nil);
+
+  bmSave := CreateCompatibleBitmap (ahdc, DestSize.x, DestSize.y);
+  GetObject(bmSave, SizeOf(BM), @BM);
+  if (BM.bmBitsPixel > 1) or (BM.bmPlanes > 1) then
+    begin
+    { create some DCs to hold temporary data}
+    hdcInvMask   := CreateCompatibleDC(ahdc);
+    hdcMask := CreateCompatibleDC(ahdc);
+
+    { each DC must select a bitmap object to store pixel data}
+    bmBackOld   := SelectObject (hdcInvMask, bmAndBack);
+
+    { set proper mapping mode}
+    SetMapMode (hdcImage, GetMapMode (ahdc));
+
+    bmObjectOld := SelectObject(hdcMask, Mask.Handle);
+
+    { create the inverse of the object mask}
+    BitBlt (hdcInvMask, 0, 0, SrcSize.x, SrcSize.y, hdcMask, 0, 0, NOTSRCCOPY);
+
+    {set the background color of the source DC to the color contained in the
+     parts of the bitmap that should be transparent, the foreground to the parts that
+     will show}
+    OldBack := SetBkColor(ahDC, clWhite);
+    OldFore := SetTextColor(ahDC, clBlack);
+
+    { Punch out a black hole in the background where the image will go}
+    SetStretchBltMode(ahDC, WhiteOnBlack);
+    StretchBlt (ahDC, XStart, YStart, DestSize.x, DestSize.y, hdcMask, 0, 0, SrcSize.x, SrcSize.y, SRCAND);
+
+    { mask out the transparent colored pixels on the bitmap}
+    BitBlt (hdcImage, 0, 0, SrcSize.x, SrcSize.y, hdcInvMask, 0, 0, SRCAND);
+
+    { XOR the bitmap with the background on the destination DC}
+    SetStretchBltMode(ahDC, ColorOnColor);
+    StretchBlt(ahDC, XStart, YStart, W, H, hdcImage, 0, 0, Image.Width, Image.Height, SRCPAINT);
+
+    SetBkColor(ahDC, OldBack);
+    SetTextColor(ahDC, OldFore);
+
+    { delete the memory bitmaps}
+    DeleteObject (SelectObject (hdcInvMask, bmBackOld));
+    SelectObject (hdcMask, bmObjectOld);
+
+    { delete the memory DCs}
+    DeleteDC (hdcInvMask);
+    DeleteDC (hdcMask);
+    end
+  else
+    begin
+    DeleteObject(bmAndBack);
+    end;
+  DeleteObject(bmSave);     
+  DeleteDC (hdcImage);
+finally
+  Image.Free;
+  end;
+end;
+
+{----------------TDib.CreateDIB}
+constructor TDib.CreateDIB(DC: HDC; Bitmap: TBitmap);
+{given a TBitmap, construct a device independent bitmap}
+var
+  ImgSize: DWord;
+begin
+InitializeBitmapInfoHeader(Bitmap.Handle);
+ImgSize := Info^.biSizeImage;
+Allocate(ImgSize);
+try
+  GetDIBX(DC, Bitmap.Handle, Bitmap.Palette);
+except
+  DeAllocate;
+  Raise;
+  end;
+end;
+
+destructor TDib.Destroy;
+begin
+DeAllocate;
+inherited Destroy;
+end;
+
+procedure TDib.Allocate(Size: integer);
+begin
+ImageSize := Size;
+{$IFDEF HL_LAZARUS}
+GetMem(Image, Size);
+{$ELSE}
+if Size < $FF00 then
+  GetMem(Image, Size)
+else
+   begin
+   FHandle := GlobalAlloc(HeapAllocFlags, Size);
+   if FHandle = 0 then
+       ABort;
+   Image := GlobalLock(FHandle);
+   end;
+{$ENDIF}
+end;
+
+procedure TDib.DeAllocate;
+begin
+if ImageSize > 0 then
+  begin
+  {$IFDEF HL_LAZARUS}
+  Freemem(Image, ImageSize);
+  {$ELSE}
+  if ImageSize < $FF00 then
+    Freemem(Image, ImageSize)
+  else
+    begin
+    GlobalUnlock(FHandle);
+    GlobalFree(FHandle);
+    end;
+  {$ENDIF}
+  ImageSize := 0;
+  end;
+if InfoSize > 0 then
+  begin
+  FreeMem(Info, InfoSize);
+  InfoSize := 0;
+  end;
+end;
+
+procedure TDib.InitializeBitmapInfoHeader(Bitmap: HBITMAP);
+var
+  BM: tagBitmap;
+  BitCount: integer;
+
+   function WidthBytes(I: integer): integer;
+   begin
+     Result := ((I + 31) div 32) * 4;
+   end;
+
+begin
+GetObject(Bitmap, SizeOf(BM), @BM);
+BitCount := BM.bmBitsPixel * BM.bmPlanes;
+if BitCount > 8 then
+  InfoSize := SizeOf(TBitmapInfoHeader)
+else
+  InfoSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * (1 shl BitCount);  
+GetMem(Info, InfoSize);
+
+with Info^ do
+  begin
+  biSize := SizeOf(TBitmapInfoHeader);
+  biWidth := BM.bmWidth;
+  biHeight := BM.bmHeight;
+  biBitCount := BM.bmBitsPixel * BM.bmPlanes;
+  biPlanes := 1;
+  biXPelsPerMeter := 0;
+  biYPelsPerMeter := 0;
+  biClrUsed := 0;
+  biClrImportant := 0;
+  biCompression := BI_RGB;
+  if biBitCount in [16, 32] then
+    biBitCount := 24;
+  biSizeImage := WidthBytes(biWidth * biBitCount) * biHeight;
+  end;
+end;
+
+procedure TDib.GetDIBX(DC: HDC; Bitmap: HBITMAP; Palette: HPALETTE);
+var
+  OldPal: HPALETTE;
+  Rslt: integer;
+  bmInfo: PBitmapInfo;
+begin
+  OldPal := 0;
+  if Palette <> 0 then
+    begin
+    OldPal := SelectPalette(DC, Palette, False);
+    RealizePalette(DC);
+    end;
+  bmInfo := PBitmapInfo(Info);
+  Rslt := GetDIBits(DC, Bitmap, 0, Info^.biHeight, Image, bmInfo^, DIB_RGB_COLORS);
+  if OldPal <> 0 then
+    SelectPalette(DC, OldPal, False);
+  if Rslt = 0 then
+    begin
+    if DC = 0 then
+      BitmapList.PurgeCache;
+    OutofMemoryError;
+    end;
+end;
+
+procedure TDib.DrawDIB(DC: HDC; X: Integer; Y: integer; W, H: integer; ROP: DWord);
+var
+  bmInfo: PBitmapInfo;
+begin
+bmInfo := PBitmapInfo(Info);
+with Info^ do
+  StretchDIBits(DC, X, Y, W, H, 0, 0, biWidth, biHeight, Image,
+      bmInfo^, DIB_RGB_COLORS, ROP);
+end;
+
+function TDib.CreateDIBmp: hBitmap;
+var
+  bmInfo: PBitmapInfo;
+  DC: HDC;
+  OldPal: HPalette;
+begin
+bmInfo := PBitmapInfo(Info);
+DC := GetDC(0);
+OldPal := SelectPalette(DC, ThePalette, False);
+RealizePalette(DC);
+try
+  Result := CreateDIBitmap(DC, bmInfo^.bmiHeader, CBM_INIT, Image,
+            bmInfo^, DIB_RGB_COLORS);
+finally
+  SelectPalette(DC, OldPal, False);
+  ReleaseDC(0, DC);
+  end;
+end;
+
+{----------------IndentManagerBasic.Create}
+constructor IndentManagerBasic.Create;
+begin
+inherited Create;
+R := TFreeList.Create;
+L := TFreeList.Create;
+end;
+
+destructor IndentManagerBasic.Destroy;
+begin
+R.Free;
+L.Free;
+inherited Destroy;
+end;
+
+procedure IndentManagerBasic.Clear;
+begin
+R.Clear;
+L.Clear;
+end;
+
+{----------------IndentManagerBasic.Reset}
+procedure IndentManagerBasic.Reset(Lf, Rt: integer);
+begin
+LfEdge := Lf;
+RtEdge := Rt;
+CurrentLevel := 0;
+end;
+
+procedure IndentManagerBasic.UpdateTable(Y: integer; IW: integer; IH: integer;
+                           Justify: JustifyType);
+{Given a floating table, update the edge information. }
+var
+  IR: IndentRec;
+begin
+  IR := IndentRec.Create;
+  if (Justify = Left) then
+    begin
+    with IR do
+      begin
+      X := LeftIndent(Y)-LfEdge + IW;
+      YT := Y;
+      YB := Y + IH;
+      Lev := 0;
+      L.Add(IR);
+      end;
+    end
+  else if (Justify = Right) then
+    begin
+    with IR do
+      begin
+      X := RightSide(Y) - RtEdge - IW;
+      YT := Y;
+      YB := Y + IH;
+      Lev := 0;
+      R.Add(IR);
+      end;
+    end;
+end;
+
+function IndentManagerBasic.LeftIndent(Y: integer): integer;
+var
+  I: integer;
+begin
+Result := 0;
+for I := 0 to L.Count-1 do
+  with IndentRec(L.Items[I]) do
+    begin
+    if (Y >= YT) and (Y < YB) and (Result < X) then   
+      Result := X;
+    end;
+Inc(Result, LfEdge);
+end;
+
+function IndentManagerBasic.RightSide(Y: integer): integer;
+{returns the current right side dimension as measured from the left, a positive
+ number}
+var
+  I: integer;
+begin
+Result := 0;
+for I := 0 to R.Count-1 do
+  with IndentRec(R.Items[I]) do
+    if (Y >= YT) and (Y < YB) and (Result > X) then   
+      Result := X;
+Inc(Result, RtEdge);
+end;
+
+function IndentManagerBasic.ImageBottom: integer;
+{finds the bottom of the last floating image}
+var
+  I: integer;
+begin
+Result := 0;
+for I := 0 to L.Count-1 do
+  with IndentRec(L.Items[I]) do
+    if (lev = 0) and (YB > Result) then
+      Result := YB;
+for I := 0 to R.Count-1 do
+  with IndentRec(R.Items[I]) do
+    if (lev = 0) and (YB > Result) then
+      Result := YB;
+end;
+
+procedure IndentManagerBasic.GetClearY(var CL, CR: integer);
+{returns the left and right Y values which will clear image margins}
+var
+  I: integer;
+begin
+CL := -1;
+for I := 0 to L.Count-1 do
+  with IndentRec(L.Items[I]) do
+    if (Lev = 0) and (YB > CL) then
+      CL := YB;
+CR := -1;
+for I := 0 to R.Count-1 do
+  with IndentRec(R.Items[I]) do
+    if (Lev = 0) and (YB > CR) then
+      CR := YB;
+Inc(CL);
+Inc(CR);
+end;
+
+function IndentManagerBasic.GetLevelClear: integer;
+{returns the left value which will clear image at this level}
+var
+  I, CurrentLevelIndent: integer;
+begin
+CurrentLevelIndent := 0;
+for I := 0 to L.Count-1 do
+  with IndentRec(L.Items[I]) do
+    if Lev = CurrentLevel then
+      CurrentLevelIndent := X;
+Result := 0;
+for I := 0 to L.Count-1 do
+  with IndentRec(L.Items[I]) do
+    if (X > CurrentLevelIndent) and (YB > Result) then
+      Result := YB;
+Inc(Result);
+end;
+
+procedure IndentManagerBasic.SetLevel(Y: integer; Level: integer);
+var
+  I: integer;
+  IR: IndentRec;
+begin
+if Level > CurrentLevel then
+  begin
+  for I := CurrentLevel+1 to Level do   {in case we skip a level}
+    begin
+    IR := IndentRec.Create;
+    with IR do
+      begin
+      Lev := I;
+      YT := Y;
+      YB := 9999999;  {replace with actual value when we know it}
+      X := LeftIndent(Y)-LfEdge + ListIndent;
+      end;
+    L.Add(IR);
+    end;
+  CurrentLevel := Level;
+  end
+else if (Level < CurrentLevel) and (CurrentLevel > 0) then
+  begin
+  for I := 0 to L.Count-1 do
+    with IndentRec(L.Items[I]) do
+      if Lev > Level then
+        begin
+        Lev := 0;
+        YB := Y-1;   {replace the 9999999 with actual end}
+        end;
+  CurrentLevel := Level;
+  end;
+end;
+
+procedure IndentManagerBasic.SetLevelSmall(Y: integer; Level: integer);
+{For 
      •  without 
          . Level will be 1 here}
+var
+  I: integer;
+  IR: IndentRec;
+begin
+if Level = CurrentLevel+1 then
+  begin
+    begin
+    IR := IndentRec.Create;
+    with IR do
+      begin
+      Lev := Level;
+      YT := Y;
+      YB := 9999999;  {replace with actual value when we know it}
+      X := LeftIndent(Y)-LfEdge + SmallListIndent;
+      end;
+    L.Add(IR);
+    end;
+  CurrentLevel := Level;
+  end
+else if (Level = CurrentLevel-1) and (CurrentLevel > 0) then
+  begin
+  for I := 0 to L.Count-1 do
+    with IndentRec(L.Items[I]) do
+      if Lev > Level then
+        begin
+        Lev := 0;
+        YB := Y-1;   {replace the 9999999 with actual end}
+        end;
+  CurrentLevel := Level;
+  end;
+end;
+
+procedure SetGlobalPalette(Value: HPalette);
+begin
+end;
+
+function CopyPalette(Source: hPalette): hPalette;
+var
+  LP: ^TLogPalette;
+  NumEntries: integer;
+begin
+Result := 0;
+GetMem(LP, Sizeof(TLogPalette) + 256*Sizeof(TPaletteEntry));
+try
+  with LP^ do
+    begin
+    palVersion := $300;
+    palNumEntries := 256;
+    NumEntries := GetPaletteEntries(Source, 0, 256, palPalEntry);
+    if NumEntries > 0 then
+      begin
+      palNumEntries := NumEntries;
+      Result := CreatePalette(LP^);
+      end;
+    end;
+finally
+  FreeMem(LP, Sizeof(TLogPalette) + 256*Sizeof(TPaletteEntry));
+  end;
+end;
+
+procedure CalcPalette(DC: HDC);
+{calculate a rainbow palette, one with equally spaced colors}
+const
+  Values: array[0..5] of integer = (55, 115, 165, 205, 235, 255);
+var
+  LP: ^TLogPalette;
+  I, J, K, Sub: integer;
+begin
+GetMem(LP, Sizeof(TLogPalette) + 256*Sizeof(TPaletteEntry));
+try
+  with LP^ do
+    begin
+    palVersion := $300;
+    palNumEntries := 256;
+    GetSystemPaletteEntries(DC, 0, 256, palPalEntry);
+    Sub := 10;  {start at entry 10}
+    for I := 0 to 5 do
+      for J := 0 to 5 do
+        for K := 0 to 5 do
+          if not ((I=5) and (J=5) and (K=5)) then  {skip the white}
+            with palPalEntry[Sub] do
+              begin
+              peBlue := Values[I];
+              peGreen := Values[J];
+              peRed := Values[K];
+              peFlags := 0;
+              Inc(Sub);
+              end;
+    for I := 1 to 24 do
+       if not (I in [7, 15, 21]) then   {these would be duplicates}  
+          with palPalEntry[Sub] do
+            begin
+            peBlue := 130 + 5*I;
+            peGreen := 130 + 5*I;
+            peRed := 130 + 5*I;
+            peFlags := 0;
+            Inc(Sub);
+            end;
+    ThePalette := CreatePalette(LP^);
+    end;
+finally
+  FreeMem(LP, Sizeof(TLogPalette) + 256*Sizeof(TPaletteEntry));
+  end;
+end;
+
+const
+  DefaultBitmap = 1002;
+  ErrBitmap = 1001;
+  ErrBitmapMask = 1005;
+  Hand_Cursor = 1003;
+  ThickIBeam_Cursor = 1006;
+
+procedure ThisExit; {$IFNDEF HL_LAZARUS}far;{$ENDIF}
+begin
+if ThePalette <> 0 then
+  DeleteObject(ThePalette);
+DefBitMap.Free;
+ErrorBitMap.Free;
+ErrorBitMapMask.Free;
+BitmapList.Free;
+WaitStream.Free;
+end;
+
+{----------------TokenObj.Create}
+constructor TokenObj.Create;
+begin
+inherited;
+S := '';
+GetMem(I, TokenLeng*Sizeof(integer));
+MaxIndex := TokenLeng;
+end;
+
+destructor TokenObj.Destroy;
+begin
+FreeMem(I);
+inherited;
+end;
+
+procedure TokenObj.AddChar(C: char; Ind: integer);
+begin
+S := S+C;
+if Length(S) > MaxIndex then
+  Begin
+  ReallocMem(I, (MaxIndex+50)*Sizeof(integer));
+  Inc(MaxIndex, 50);
+  end;
+I^[Length(S)] := Ind;
+end;
+
+procedure TokenObj.Clear;
+begin
+S := '';
+end;
+
+procedure TokenObj.Concat(T: TokenObj);
+var
+  K: integer;
+begin
+K := Length(S);
+S := S+T.S;
+if K + Length(T.S) > MaxIndex then
+  begin
+  ReallocMem(I, (K+Length(T.S)+50)*Sizeof(integer));
+  MaxIndex := K+Length(T.S)+50;
+  end;
+Move(T.I^, I^[K+1], Length(T.S)*Sizeof(integer));
+end;
+
+initialization
+DC := GetDC(0);
+try
+  ColorBits := GetDeviceCaps(DC, BitsPixel)*GetDeviceCaps(DC, Planes);
+
+  if ColorBits <= 4 then
+    ColorBits := 4
+  else if ColorBits <= 8 then
+    ColorBits := 8
+  else  ColorBits := 24;
+
+  ThePalette := 0;
+  if ColorBits = 8 then
+    CalcPalette(DC);
+finally
+  ReleaseDC(0, DC);
+  end;
+
+DefBitMap := TBitmap.Create;
+ErrorBitMap := TBitmap.Create;
+ErrorBitMapMask := TBitmap.Create;
+{$IFNDEF HL_LAZARUS}
+DefBitMap.Handle := LoadBitmap(HInstance, MakeIntResource(DefaultBitmap));
+ErrorBitMap.Handle := LoadBitmap(HInstance, MakeIntResource(ErrBitmap));
+ErrorBitMapMask.Handle := LoadBitmap(HInstance, MakeIntResource(ErrBitmapMask));
+Screen.Cursors[HandCursor] := LoadCursor(HInstance, MakeIntResource(Hand_Cursor));
+Screen.Cursors[ThickIBeamCursor] := LoadCursor(HInstance, MakeIntResource(ThickIBeam_Cursor));
+Screen.Cursors[UpDownCursor] := LoadCursor(HInstance, 'UPDOWNCURSOR');
+Screen.Cursors[UpOnlyCursor] := LoadCursor(HInstance, 'UPONLYCURSOR');
+Screen.Cursors[DownOnlyCursor] := LoadCursor(HInstance, 'DOWNONLYCURSOR');
+{$ENDIF}
+BitmapList := TStringBitmapList.Create;
+BitmapList.Sorted := True;
+
+WaitStream := TMemoryStream.Create;
+
+Finalization
+ThisExit;
+
+end.
+
+
+