mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-06 05:18:00 +02:00
3007 lines
81 KiB
ObjectPascal
3007 lines
81 KiB
ObjectPascal
{Version 7.5}
|
|
{*********************************************************}
|
|
{* HTMLLITE.PAS *}
|
|
{* Copyright (c) 1995-2002 by *}
|
|
{* L. David Baldwin *}
|
|
{* All rights reserved. *}
|
|
{*********************************************************}
|
|
|
|
{$i LiteCons.inc}
|
|
|
|
unit HTMLLite;
|
|
|
|
interface
|
|
|
|
{$IFDEF HL_LAZARUS}
|
|
uses
|
|
Classes, SysUtils, LCLIntf, 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;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; 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 := '<img src="'+FName+'">';
|
|
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;
|
|
{$IFNDEF NoThreads}
|
|
ParseThread.Resume;
|
|
{$ENDIF}
|
|
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;
|
|
Cursor:=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;
|
|
|
|
Canvas.Brush.Color:=clGreen;
|
|
Canvas.FillRect(Rect(0,0,200,200));
|
|
|
|
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
|
|
writeln('TPaintPanel.Paint B Canvas.Handle=',HexStr(Cardinal(Canvas.Handle),8));
|
|
{$IFDEF HL_LAZARUS}
|
|
Canvas2.Handle:=0;
|
|
{$ENDIF}
|
|
Canvas2.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TPaintPanel.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
writeln('TPaintPanel.CreateWnd ',HexStr(Cardinal(Self),8),' ',HexStr(Cardinal(Handle),8));
|
|
end;
|
|
|
|
procedure TPaintPanel.DestroyWnd;
|
|
begin
|
|
writeln('TPaintPanel.DestroyWnd ',HexStr(Cardinal(Self),8));
|
|
inherited DestroyWnd;
|
|
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
|
|
writeln('TPaintPanel.DoBackground A ',HexStr(Cardinal(ACanvas),8));
|
|
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.
|
|
|