Turbopower_ipro: Move general declarations and general-purpose classes from unit IpHtml to new units IpHtmlTypes and IpHtmlClasses, respectively.

This commit is contained in:
wp_xyz 2022-05-28 17:49:29 +02:00
parent db6f77000b
commit e9948b6fa4
12 changed files with 625 additions and 516 deletions

View File

@ -6,7 +6,7 @@ interface
uses uses
Classes, Contnrs, SysUtils, Graphics, Classes, Contnrs, SysUtils, Graphics,
IpHtmlProp, IpHtmlUtils; IpHtmlTypes, IpHtmlUtils;
type type
TCSSGroup = class TCSSGroup = class

View File

@ -54,8 +54,7 @@ uses
Types, contnrs, Types, contnrs,
LCLType, GraphType, LCLProc, LCLIntf, LResources, LMessages, LCLMemManager, LCLType, GraphType, LCLProc, LCLIntf, LResources, LMessages, LCLMemManager,
Translations, FileUtil, LazStringUtils, LConvEncoding, LazUTF8, AvgLvlTree, Translations, FileUtil, LazStringUtils, LConvEncoding, LazUTF8, AvgLvlTree,
IpHtmlTabList, Messages, SysUtils, Classes, Graphics, TypInfo,
Messages, SysUtils, Classes, Graphics,
{$IFDEF UseGifImageUnit} //TODO all of this units not exists {$IFDEF UseGifImageUnit} //TODO all of this units not exists
GifImage, GifImage,
{$ELSE} {$ELSE}
@ -70,9 +69,9 @@ uses
{$IFDEF UsePNGGraphic} {$IFDEF UsePNGGraphic}
IpPNGImg, IpPNGImg,
{$ENDIF} {$ENDIF}
TypInfo,
GraphUtil, Controls, StdCtrls, ExtCtrls, Buttons, Forms, ClipBrd, Dialogs, GraphUtil, Controls, StdCtrls, ExtCtrls, Buttons, Forms, ClipBrd, Dialogs,
IpConst, IpStrms, IpUtils, iphtmlprop, IpMsg, IpCSS, IpHtmlUtils; IpConst, IpStrms, IpUtils, IpHtmlTypes, IpHtmlClasses, IpHtmlProp, IpMsg,
IpCSS, IpHtmlUtils, IpHtmlTabList;
type type
{Note: Some of the code below relies on the fact that {Note: Some of the code below relies on the fact that
@ -80,19 +79,6 @@ type
{$I iphtmlgenerated.inc} {$I iphtmlgenerated.inc}
const
IPMAXFRAMES = 256; {maximum number of frames in a single frameset}
MAXINTS = 4096; {buffer size - this should be way more than needed}
TINTARRGROWFACTOR = 64;
DEFAULT_PRINTMARGIN = 0.5; {inches}
FONTSIZESVALUESARRAY : array[0..6] of integer = (8,10,12,14,18,24,36);
MAXWORDS = 65536;
DEFAULT_LINKS_UNDERLINED = false;
ZOOM_TO_FIT = 0;
ZOOM_TO_FIT_WIDTH = -1;
ZOOM_TO_FIT_HEIGHT = -2;
type type
TIpEnumItemsMethod = TLCLEnumItemsMethod; TIpEnumItemsMethod = TLCLEnumItemsMethod;
TIpHtmlPoolManager = class(TLCLNonFreeMemManager) TIpHtmlPoolManager = class(TLCLNonFreeMemManager)
@ -103,93 +89,6 @@ type
TIpHtml = class; TIpHtml = class;
TIpAbstractHtmlDataProvider = class; TIpAbstractHtmlDataProvider = class;
TIpHtmlInteger = class(TPersistent)
{ Integer property which can be scaled}
private
FValue : Integer;
FChange: TNotifyEvent;
procedure DoChange;
function GetValue: Integer;
procedure SetValue(const Value: Integer);
public
constructor Create(AValue: Integer);
property Value: Integer read GetValue write SetValue;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TIpHtmlPixelsType = (hpUndefined, hpAbsolute);
TIpHtmlPixels = class(TPersistent)
private
FValue : Integer;
FPixelsType : TIpHtmlPixelsType;
FChange: TNotifyEvent;
procedure DoChange;
function GetValue: Integer;
procedure SetPixelsType(const Value: TIpHtmlPixelsType);
procedure SetValue(const Value: Integer);
public
property Value: Integer read GetValue write SetValue;
property PixelsType: TIpHtmlPixelsType read FPixelsType write SetPixelsType;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TIpHtmlLengthType = (hlUndefined, hlAbsolute, hlPercent);
TIpHtmlLength = class(TPersistent)
private
FLengthValue: Integer;
FLengthType: TIpHtmlLengthType;
FChange: TNotifyEvent;
procedure SetLengthType(const Value: TIpHtmlLengthType);
procedure SetLengthValue(const Value: Integer);
function GetLengthValue: Integer;
procedure DoChange;
public
property LengthValue : Integer read GetLengthValue write SetLengthValue;
property LengthType : TIpHtmlLengthType read FLengthType write SetLengthType;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TIpHtmlMultiLengthType = (hmlUndefined, hmlAbsolute, hmlPercent, hmlRelative);
TIpHtmlMultiLength = class(TPersistent)
private
FLengthValue : Integer;
FLengthType : TIpHtmlMultiLengthType;
function GetLengthValue: Integer;
public
property LengthValue: Integer read GetLengthValue write FLengthValue;
property LengthType: TIpHtmlMultiLengthType read FLengthType write FLengthType;
end;
TIpHtmlMultiLengthList = class(TPersistent)
private
List: TFPList;
function GetEntries: Integer;
function GetValues(Index: Integer): TIpHtmlMultiLength;
public
constructor Create;
destructor Destroy; override;
property Values[Index: Integer]: TIpHtmlMultiLength read GetValues;
procedure AddEntry(Value: TIpHtmlMultiLength);
procedure Clear;
property Entries: Integer read GetEntries;
end;
TIpHtmlRelSizeType = (hrsUnspecified, hrsAbsolute, hrsRelative);
TIpHtmlRelSize = class(TPersistent)
private
FChange: TNotifyEvent;
FSizeType : TIpHtmlRelSizeType;
FValue : Integer;
procedure SetSizeType(const Value: TIpHtmlRelSizeType);
procedure SetValue(const Value: Integer);
procedure DoChange;
public
property SizeType : TIpHtmlRelSizeType read FSizeType write SetSizeType;
property Value : Integer read FValue write SetValue;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TIpHtmlNode = class; TIpHtmlNode = class;
TIpHtmlNodeCore = class; TIpHtmlNodeCore = class;
TIpHtmlNodeBlock = class; TIpHtmlNodeBlock = class;
@ -227,8 +126,6 @@ type
TIpHtmlBaseLayouterClass = class of TIpHtmlBaseLayouter; TIpHtmlBaseLayouterClass = class of TIpHtmlBaseLayouter;
TIntArr = class;
{ TIpHtmlBaseTableLayouter } { TIpHtmlBaseTableLayouter }
// Abstract base class for layout methods of a HTML table // Abstract base class for layout methods of a HTML table
@ -252,9 +149,6 @@ type
TIpHtmlBaseTableLayouterClass = class of TIpHtmlBaseTableLayouter; TIpHtmlBaseTableLayouterClass = class of TIpHtmlBaseTableLayouter;
TElementType = (etWord, etObject, etSoftLF, etHardLF, etClearLeft,
etClearRight, etClearBoth, etIndent, etOutdent, etSoftHyphen);
TIpHtmlElement = record TIpHtmlElement = record
ElementType : TElementType; ElementType : TElementType;
AnsiWord: string; AnsiWord: string;
@ -352,8 +246,6 @@ type
{ TIpHtmlNodeCore } { TIpHtmlNodeCore }
TIpHtmlDirection = (hdLTR, hdRTL);
TIpHtmlNodeCore = class(TIpHtmlNodeMulti) TIpHtmlNodeCore = class(TIpHtmlNodeMulti)
private private
FInlineCSSProps: TCSSProps; // props from the style attribute FInlineCSSProps: TCSSProps; // props from the style attribute
@ -400,8 +292,6 @@ type
procedure Invalidate; override; procedure Invalidate; override;
end; end;
TIpHtmlImageAlign = (hiaTop, hiaMiddle, hiaBottom, hiaLeft, hiaRight, hiaCenter);
TIpHtmlNodeAlignInline = class(TIpHtmlNodeInline) TIpHtmlNodeAlignInline = class(TIpHtmlNodeInline)
private private
FAlignment: TIpHtmlImageAlign; FAlignment: TIpHtmlImageAlign;
@ -595,10 +485,8 @@ type
end; end;
TIpHtmlNodeSCRIPT = class(TIpHtmlNodeNv); TIpHtmlNodeSCRIPT = class(TIpHtmlNodeNv);
TIpHtmlNodeNOSCRIPT = class(TIpHtmlNodeInline); TIpHtmlNodeNOSCRIPT = class(TIpHtmlNodeInline);
TIpHtmlHeaderSize = 1..6;
TIpHtmlNodeHeader = class(TIpHtmlNodeInline) TIpHtmlNodeHeader = class(TIpHtmlNodeInline)
private private
FAlign : TIpHtmlAlign; FAlign : TIpHtmlAlign;
@ -644,7 +532,6 @@ type
TIpHtmlNodeADDRESS = class(TIpHtmlNodeInline); TIpHtmlNodeADDRESS = class(TIpHtmlNodeInline);
TIpHtmlULType = (ulDisc, ulSquare, ulCircle);
TIpHtmlNodeList = class(TIpHtmlNodeInline) TIpHtmlNodeList = class(TIpHtmlNodeInline)
private private
FCompact : Boolean; FCompact : Boolean;
@ -663,7 +550,6 @@ type
TIpHtmlNodeDIR = class(TIpHtmlNodeList); TIpHtmlNodeDIR = class(TIpHtmlNodeList);
TIpHtmlNodeMENU = class(TIpHtmlNodeList); TIpHtmlNodeMENU = class(TIpHtmlNodeList);
TIpHtmlOLStyle = (olArabic, olLowerAlpha, olUpperAlpha, olLowerRoman, olUpperRoman);
TIpHtmlNodeOL = class(TIpHtmlNodeInline) TIpHtmlNodeOL = class(TIpHtmlNodeInline)
private private
FCompact : Boolean; FCompact : Boolean;
@ -709,7 +595,6 @@ type
property Value : Integer read FValue write SetValue; property Value : Integer read FValue write SetValue;
end; end;
TIpHtmlFormMethod = (hfmGet, hfmPost);
TIpHtmlNodeFORM = class(TIpHtmlNodeInline) TIpHtmlNodeFORM = class(TIpHtmlNodeInline)
private private
FAccept: string; FAccept: string;
@ -771,6 +656,7 @@ type
property Title : string read FTitle write FTitle; property Title : string read FTitle write FTitle;
end; end;
{ TIpHtmlNodeBODY } { TIpHtmlNodeBODY }
TIpHtmlNodeBODY = class(TIpHtmlNodeBlock) TIpHtmlNodeBODY = class(TIpHtmlNodeBlock)
@ -817,7 +703,6 @@ type
property Title; property Title;
end; end;
TIpHtmlFrameScrolling = (hfsAuto, hfsYes, hfsNo);
TIpHtmlNodeFRAME = class(TIpHtmlNodeCore) TIpHtmlNodeFRAME = class(TIpHtmlNodeCore)
private private
FFrameBorder: Integer; FFrameBorder: Integer;
@ -999,9 +884,6 @@ type
property DateTime : string read FDateTime write FDateTime; property DateTime : string read FDateTime write FDateTime;
end; end;
TIpHtmlFontStyles = (hfsTT, hfsI, hfsB, hfsU, hfsSTRIKE, hfsS,
hfsBIG, hfsSMALL, hfsSUB, hfsSUP);
TIpHtmlNodeFontStyle = class(TIpHtmlNodeGenInline) TIpHtmlNodeFontStyle = class(TIpHtmlNodeGenInline)
private private
FHFStyle : TIpHtmlFontStyles; FHFStyle : TIpHtmlFontStyles;
@ -1014,8 +896,6 @@ type
property Style : TIpHtmlFontStyles read FHFStyle write FHFStyle; property Style : TIpHtmlFontStyles read FHFStyle write FHFStyle;
end; end;
TIpHtmlPhraseStyle = (hpsEM, hpsSTRONG, hpsDFN, hpsCODE, hpsSAMP,
hpsKBD, hpsVAR, hpsCITE, hpsABBR, hpsACRONYM);
TIpHtmlNodePhrase = class(TIpHtmlNodeGenInline) TIpHtmlNodePhrase = class(TIpHtmlNodeGenInline)
private private
FPhrStyle : TIpHtmlPhraseStyle; FPhrStyle : TIpHtmlPhraseStyle;
@ -1055,8 +935,6 @@ type
property Width : TIpHtmlLength read FWidth write FWidth; property Width : TIpHtmlLength read FWidth write FWidth;
end; end;
TIpHtmlBreakClear = (hbcNone, hbcLeft, hbcRight, hbcAll);
{ TIpHtmlNodeBR } { TIpHtmlNodeBR }
TIpHtmlNodeBR = class(TIpHtmlNodeInline) TIpHtmlNodeBR = class(TIpHtmlNodeInline)
@ -1084,7 +962,6 @@ type
public public
end; end;
TIpHtmlMapShape = (hmsDefault, hmsRect, hmsCircle, hmsPoly);
TIpHtmlNodeA = class(TIpHtmlNodeInline) TIpHtmlNodeA = class(TIpHtmlNodeInline)
private private
FHRef: string; FHRef: string;
@ -1262,7 +1139,6 @@ type
property Width : TIpHtmlLength read FWidth write FWidth; property Width : TIpHtmlLength read FWidth write FWidth;
end; end;
TIpHtmlObjectValueType = (hovtData, hovtRef, hovtObject);
TIpHtmlNodePARAM = class(TIpHtmlNodeNv) TIpHtmlNodePARAM = class(TIpHtmlNodeNv)
private private
FId: string; FId: string;
@ -1366,7 +1242,6 @@ type
property Type_ : string read FType write FType; property Type_ : string read FType write FType;
end; end;
TIpHtmlVAlignment2 = (hva2Top, hva2Bottom, hva2Left, hva2Right);
{ TIpHtmlNodeCAPTION } { TIpHtmlNodeCAPTION }
@ -1381,49 +1256,6 @@ type
property Align : TIpHtmlVAlignment2 read FAlign write FAlign; property Align : TIpHtmlVAlignment2 read FAlign write FAlign;
end; end;
TIpHtmlFrameProp = (hfVoid, hfAbove, hfBelow, hfHSides, hfLhs, hfRhs,
hfvSides, hfBox, hfBorder);
TIpHtmlRules = (hrNone, hrGroups, hrRows, hrCols, hrAll);
TInternalIntArr = array [0..Pred(MAXINTS)] of Integer;
PInternalIntArr = ^TInternalIntArr;
TIntArr = class
private
InternalIntArr : PInternalIntArr;
IntArrSize : Integer;
function GetValue(Index: Integer): Integer;
procedure SetValue(Index, Value: Integer);
public
destructor Destroy; override;
property Value[Index: Integer]: Integer read GetValue write SetValue; default;
end;
TInternalRectArr = array [0..Pred(MAXINTS)] of PRect;
PInternalRectArr = ^TInternalRectArr;
TRectArr = class
private
InternalRectArr : PInternalRectArr;
IntArrSize : Integer;
function GetValue(Index: Integer): PRect;
procedure SetValue(Index: Integer; Value: PRect);
public
destructor Destroy; override;
property Value[Index: Integer]: PRect read GetValue write SetValue; default;
end;
TInternalRectRectArr = array [0..Pred(MAXINTS)] of TRectArr;
PInternalRectRectArr = ^TInternalRectRectArr;
TRectRectArr = class
protected
InternalRectRectArr : PInternalRectRectArr;
IntArrSize : Integer;
function GetValue(Index: Integer): TRectArr;
public
destructor Destroy; override;
property Value[Index: Integer]: TRectArr read GetValue; default;
procedure Delete(Index: Integer);
end;
{ TIpHtmlNodeTABLE } { TIpHtmlNodeTABLE }
@ -1602,8 +1434,6 @@ type
property TextColor: TColor read FTextColor write SetTextColor; property TextColor: TColor read FTextColor write SetTextColor;
end; end;
TIpHtmlCellScope = (hcsUnspec, hcsRow, hcsCol, hcsRowGroup, hcsColGroup);
{ TIpHtmlNodeTableHeaderOrCell } { TIpHtmlNodeTableHeaderOrCell }
TIpHtmlNodeTableHeaderOrCell = class(TIpHtmlNodeBlock) TIpHtmlNodeTableHeaderOrCell = class(TIpHtmlNodeBlock)
@ -1666,9 +1496,6 @@ type
{ TIpHtmlNodeINPUT } { TIpHtmlNodeINPUT }
TIpHtmlInputType = (hitText, hitPassword, hitCheckbox, hitRadio,
hitSubmit, hitReset, hitFile, hitHidden, hitImage, hitButton);
TIpHtmlNodeINPUT = class(TIpHtmlNodeControl) TIpHtmlNodeINPUT = class(TIpHtmlNodeControl)
private private
FChecked: Boolean; FChecked: Boolean;
@ -1718,8 +1545,6 @@ type
property Value : string read FValue write FValue; property Value : string read FValue write FValue;
end; end;
TIpHtmlButtonType = (hbtSubmit, hbtReset, hbtButton);
TIpHtmlNodeBUTTON = class(TIpHtmlNodeControl) TIpHtmlNodeBUTTON = class(TIpHtmlNodeControl)
private private
FTabIndex: Integer; FTabIndex: Integer;
@ -1872,8 +1697,6 @@ type
function FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string; virtual; abstract; function FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string; virtual; abstract;
end; end;
TIpHtmlRenderDevice = (rdScreen, rdPrinter, rdPreview);
TWriteCharProvider = procedure(C : AnsiChar) of object; TWriteCharProvider = procedure(C : AnsiChar) of object;
TIpHtmlDataGetImageEvent = TIpHtmlDataGetImageEvent =
@ -2289,9 +2112,6 @@ type
end; end;
TIpHtmlEnumerator = procedure(Document: TIpHtml) of object; TIpHtmlEnumerator = procedure(Document: TIpHtml) of object;
TIpScrollAction = (hsaHome, hsaEnd, hsaPgUp, hsaPgDn,
hsaLeft, hsaRight, hsaUp, hsaDown);
TIpHtmlFrame = class TIpHtmlFrame = class
protected protected
@ -2710,11 +2530,6 @@ type
TIdFindNodeCriteria = function(ACurrNode: TIpHtmlNodeCore; const AParamStr: string): Boolean; TIdFindNodeCriteria = function(ACurrNode: TIpHtmlNodeCore; const AParamStr: string): Boolean;
var var
// true during print preview only, public to let print preview unit access it
ScaleFonts : Boolean = False;
ScaleBitmaps : Boolean = False;
BWPrinter: Boolean;
Aspect : Double;
// LayouterClass is initialized by the layout unit. // LayouterClass is initialized by the layout unit.
BlockLayouterClass: TIpHtmlBaseLayouterClass; BlockLayouterClass: TIpHtmlBaseLayouterClass;
TableElemLayouterClass: TIpHtmlBaseLayouterClass; TableElemLayouterClass: TIpHtmlBaseLayouterClass;
@ -3243,174 +3058,6 @@ begin
end; end;
{ TIpHtmlInteger }
constructor TIpHtmlInteger.Create(AValue: Integer);
begin
inherited Create;
FValue := AValue;
end;
procedure TIpHtmlInteger.DoChange;
begin
if assigned(FChange) then
FChange(Self);
end;
function TIpHtmlInteger.GetValue: Integer;
begin
if ScaleBitmaps then
Result := round(FValue * Aspect)
else
Result := FValue;
end;
procedure TIpHtmlInteger.SetValue(const Value: Integer);
begin
if Value <> FValue then begin
FValue := Value;
DoChange;
end;
end;
{ TIpHtmlPixels }
procedure TIpHtmlPixels.DoChange;
begin
if assigned(FChange) then
FChange(Self);
end;
function TIpHtmlPixels.GetValue: Integer;
begin
if (PixelsType = hpAbsolute) and ScaleBitmaps then
Result := round(FValue * Aspect)
else
Result := FValue;
end;
procedure TIpHtmlPixels.SetPixelsType(const Value: TIpHtmlPixelsType);
begin
if Value <> FPixelsType then begin
FPixelsType := Value;
DoChange;
end;
end;
procedure TIpHtmlPixels.SetValue(const Value: Integer);
begin
if Value <> FValue then begin
FValue := Value;
DoChange;
end;
end;
{ TIpHtmlRelSize }
procedure TIpHtmlRelSize.DoChange;
begin
if assigned(FChange) then
FChange(Self);
end;
procedure TIpHtmlRelSize.SetSizeType(const Value: TIpHtmlRelSizeType);
begin
if Value <> FSizeType then begin
FSizeType := Value;
DoChange;
end;
end;
procedure TIpHtmlRelSize.SetValue(const Value: Integer);
begin
if Value <> FValue then begin
FValue := Value;
DoChange;
end;
end;
{ TIpHtmlLength }
procedure TIpHtmlLength.DoChange;
begin
if Assigned(FChange) then
FChange(Self);
end;
function TIpHtmlLength.GetLengthValue: Integer;
begin
if (LengthType = hlAbsolute) and ScaleBitmaps then
Result := round(FLengthValue * Aspect)
else
Result := FLengthValue;
end;
procedure TIpHtmlLength.SetLengthType(const Value: TIpHtmlLengthType);
begin
if Value <> FLengthType then begin
FLengthType := Value;
DoChange;
end;
end;
procedure TIpHtmlLength.SetLengthValue(const Value: Integer);
begin
if Value <> FLengthValue then begin
FLengthValue := Value;
DoChange;
end;
end;
{ TIpHtmlMultiLength }
function TIpHtmlMultiLength.GetLengthValue: Integer;
begin
if (LengthType = hmlAbsolute) and ScaleBitmaps then
Result := round(FLengthValue * Aspect)
else
Result := FLengthValue;
end;
{ TIpHtmlMultiLengthList }
procedure TIpHtmlMultiLengthList.AddEntry(Value: TIpHtmlMultiLength);
begin
List.Add(Value);
end;
procedure TIpHtmlMultiLengthList.Clear;
begin
while List.Count > 0 do begin
TIpHtmlMultiLength(List[0]).Free;
List.Delete(0);
end;
end;
constructor TIpHtmlMultiLengthList.Create;
begin
inherited Create;
List := TFPList.Create;
end;
destructor TIpHtmlMultiLengthList.Destroy;
begin
inherited;
Clear;
List.Free;
end;
function TIpHtmlMultiLengthList.GetEntries: Integer;
begin
Result := List.Count;
end;
function TIpHtmlMultiLengthList.GetValues(
Index: Integer): TIpHtmlMultiLength;
begin
Result := TIpHtmlMultiLength(List[Index]);
end;
{ TIpHtmlBaseLayouter } { TIpHtmlBaseLayouter }
constructor TIpHtmlBaseLayouter.Create(AOwner: TIpHtmlNodeCore); constructor TIpHtmlBaseLayouter.Create(AOwner: TIpHtmlNodeCore);
@ -12861,135 +12508,6 @@ begin
@FlatSB_SetScrollInfo := @LazFlatSB_SetScrollInfo; @FlatSB_SetScrollInfo := @LazFlatSB_SetScrollInfo;
end; end;
{ TIntArr }
destructor TIntArr.Destroy;
begin
inherited;
Freemem(InternalIntArr);
end;
function TIntArr.GetValue(Index: Integer): Integer;
begin
if (Index < 0) or (Index >= IntArrSize) then
Result := 0
else
Result := InternalIntArr^[Index];
end;
procedure TIntArr.SetValue(Index, Value: Integer);
var
p: ^Integer;
NewSize: Integer;
begin
if Index >= 0 then begin
if Index >= IntArrSize then begin
NewSize := IntArrSize;
repeat
Inc(NewSize, TINTARRGROWFACTOR);
until Index < NewSize;
{code below does not check if InternalIntArr<>nil}
ReallocMem(InternalIntArr,NewSize * sizeof(PtrInt));
p := pointer(InternalIntArr);
Inc(p, IntArrSize);
fillchar(p^, (NewSize - IntArrSize)*sizeOf(PtrInt), 0);
IntArrSize := NewSize;
end;
InternalIntArr^[Index] := Value;
end;
end;
{ TRectArr }
destructor TRectArr.Destroy;
begin
inherited;
Freemem(InternalRectArr);
end;
function TRectArr.GetValue(Index: Integer): PRect;
begin
Assert(Self <> nil);
if (Index < 0) or (Index >= IntArrSize) then
Result := nil
else
Result := InternalRectArr^[Index];
end;
procedure TRectArr.SetValue(Index: Integer; Value: PRect);
var
P: Pointer;
NewSize: Integer;
begin
Assert(Self <> nil);
if Index >= 0 then begin
if Index >= IntArrSize then begin
NewSize := IntArrSize;
repeat
Inc(NewSize, TINTARRGROWFACTOR);
until Index < NewSize;
{code below does not check if InternalIntArr<>nil and set buggy IntArrSize}
ReallocMem(InternalRectArr,NewSize * sizeof(PtrInt));
P := pointer(InternalRectArr);
Inc(P, IntArrSize);
fillchar(p^, (NewSize - IntArrSize)*sizeOf(PtrInt), 0);
IntArrSize:=NewSize;
end;
InternalRectArr^[Index] := Value;
end;
end;
{ TRectRectArr }
procedure TRectRectArr.Delete(Index: Integer);
var
i: Integer;
begin
if (Index >= 0) and (Index < IntArrSize) then begin
Value[Index].Free;
for i := 1 to IntArrSize - 1 do
InternalRectRectArr[i-1] := InternalRectRectArr[i];
InternalRectRectArr[IntArrSize - 1] := nil;
end;
end;
destructor TRectRectArr.Destroy;
var
i: Integer;
begin
inherited;
for i := 0 to IntArrSize - 1 do
Delete(i);
if InternalRectRectArr <> nil then
Freemem(InternalRectRectArr);
end;
function TRectRectArr.GetValue(Index: Integer): TRectArr;
var
P: ^Pointer;
NewSize: Integer;
begin
if Index >= 0 then begin
if Index >= IntArrSize then begin
NewSize := IntArrSize;
repeat
Inc(NewSize, TINTARRGROWFACTOR);
until Index < NewSize;
{code below does not check if InternalIntArr<>nil and set buggy IntArrSize}
ReallocMem(InternalRectRectArr,NewSize * sizeof(PtrInt));
p := pointer(InternalRectRectArr);
Inc(p, IntArrSize);
fillchar(p^, (NewSize - IntArrSize)*sizeOf(PtrInt), 0);
IntArrSize:=NewSize;
end;
Result := InternalRectRectArr^[Index];
if Result = nil then begin
Result := TRectArr.Create;
InternalRectRectArr^[Index] := Result;
end;
end else
Result := nil;
end;
{ TIpHtmlPreviewSettings } { TIpHtmlPreviewSettings }

View File

@ -7,7 +7,7 @@ interface
uses uses
types, Classes, SysUtils, LCLPRoc, LCLIntf, Graphics, types, Classes, SysUtils, LCLPRoc, LCLIntf, Graphics,
IpUtils, IpHtml, IpHtmlProp, IpHtmlUtils; IpUtils, IpHtmlTypes, IpHtmlProp, IpHtmlUtils, IpHtml;
type type

View File

@ -0,0 +1,446 @@
unit IpHtmlClasses;
{$mode Delphi}
interface
uses
Classes, SysUtils, Types,
IpHtmlTypes;
type
{ Integer property which can be scaled}
TIpHtmlInteger = class(TPersistent)
private
FValue : Integer;
FChange: TNotifyEvent;
procedure DoChange;
function GetValue: Integer;
procedure SetValue(const Value: Integer);
public
constructor Create(AValue: Integer);
property Value: Integer read GetValue write SetValue;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TIpHtmlPixels = class(TPersistent)
private
FValue : Integer;
FPixelsType : TIpHtmlPixelsType;
FChange: TNotifyEvent;
procedure DoChange;
function GetValue: Integer;
procedure SetPixelsType(const Value: TIpHtmlPixelsType);
procedure SetValue(const Value: Integer);
public
property Value: Integer read GetValue write SetValue;
property PixelsType: TIpHtmlPixelsType read FPixelsType write SetPixelsType;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TIpHtmlLength = class(TPersistent)
private
FLengthValue: Integer;
FLengthType: TIpHtmlLengthType;
FChange: TNotifyEvent;
procedure SetLengthType(const Value: TIpHtmlLengthType);
procedure SetLengthValue(const Value: Integer);
function GetLengthValue: Integer;
procedure DoChange;
public
property LengthValue : Integer read GetLengthValue write SetLengthValue;
property LengthType : TIpHtmlLengthType read FLengthType write SetLengthType;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TIpHtmlMultiLengthType = (hmlUndefined, hmlAbsolute, hmlPercent, hmlRelative);
TIpHtmlMultiLength = class(TPersistent)
private
FLengthValue : Integer;
FLengthType : TIpHtmlMultiLengthType;
function GetLengthValue: Integer;
public
property LengthValue: Integer read GetLengthValue write FLengthValue;
property LengthType: TIpHtmlMultiLengthType read FLengthType write FLengthType;
end;
TIpHtmlMultiLengthList = class(TPersistent)
private
List: TFPList;
function GetEntries: Integer;
function GetValues(Index: Integer): TIpHtmlMultiLength;
public
constructor Create;
destructor Destroy; override;
property Values[Index: Integer]: TIpHtmlMultiLength read GetValues;
procedure AddEntry(Value: TIpHtmlMultiLength);
procedure Clear;
property Entries: Integer read GetEntries;
end;
TIpHtmlRelSizeType = (hrsUnspecified, hrsAbsolute, hrsRelative);
TIpHtmlRelSize = class(TPersistent)
private
FChange: TNotifyEvent;
FSizeType : TIpHtmlRelSizeType;
FValue : Integer;
procedure SetSizeType(const Value: TIpHtmlRelSizeType);
procedure SetValue(const Value: Integer);
procedure DoChange;
public
property SizeType : TIpHtmlRelSizeType read FSizeType write SetSizeType;
property Value : Integer read FValue write SetValue;
property OnChange: TNotifyEvent read FChange write FChange;
end;
TInternalIntArr = array [0..Pred(MAXINTS)] of Integer;
PInternalIntArr = ^TInternalIntArr;
TIntArr = class
private
InternalIntArr : PInternalIntArr;
IntArrSize : Integer;
function GetValue(Index: Integer): Integer;
procedure SetValue(Index, Value: Integer);
public
destructor Destroy; override;
property Value[Index: Integer]: Integer read GetValue write SetValue; default;
end;
TInternalRectArr = array [0..Pred(MAXINTS)] of PRect;
PInternalRectArr = ^TInternalRectArr;
TRectArr = class
private
InternalRectArr : PInternalRectArr;
IntArrSize : Integer;
function GetValue(Index: Integer): PRect;
procedure SetValue(Index: Integer; Value: PRect);
public
destructor Destroy; override;
property Value[Index: Integer]: PRect read GetValue write SetValue; default;
end;
TInternalRectRectArr = array [0..Pred(MAXINTS)] of TRectArr;
PInternalRectRectArr = ^TInternalRectRectArr;
TRectRectArr = class
protected
InternalRectRectArr : PInternalRectRectArr;
IntArrSize : Integer;
function GetValue(Index: Integer): TRectArr;
public
destructor Destroy; override;
property Value[Index: Integer]: TRectArr read GetValue; default;
procedure Delete(Index: Integer);
end;
implementation
{ TIpHtmlInteger }
constructor TIpHtmlInteger.Create(AValue: Integer);
begin
inherited Create;
FValue := AValue;
end;
procedure TIpHtmlInteger.DoChange;
begin
if assigned(FChange) then
FChange(Self);
end;
function TIpHtmlInteger.GetValue: Integer;
begin
if ScaleBitmaps then
Result := round(FValue * Aspect)
else
Result := FValue;
end;
procedure TIpHtmlInteger.SetValue(const Value: Integer);
begin
if Value <> FValue then begin
FValue := Value;
DoChange;
end;
end;
{ TIpHtmlPixels }
procedure TIpHtmlPixels.DoChange;
begin
if assigned(FChange) then
FChange(Self);
end;
function TIpHtmlPixels.GetValue: Integer;
begin
if (PixelsType = hpAbsolute) and ScaleBitmaps then
Result := round(FValue * Aspect)
else
Result := FValue;
end;
procedure TIpHtmlPixels.SetPixelsType(const Value: TIpHtmlPixelsType);
begin
if Value <> FPixelsType then begin
FPixelsType := Value;
DoChange;
end;
end;
procedure TIpHtmlPixels.SetValue(const Value: Integer);
begin
if Value <> FValue then begin
FValue := Value;
DoChange;
end;
end;
{ TIpHtmlRelSize }
procedure TIpHtmlRelSize.DoChange;
begin
if assigned(FChange) then
FChange(Self);
end;
procedure TIpHtmlRelSize.SetSizeType(const Value: TIpHtmlRelSizeType);
begin
if Value <> FSizeType then begin
FSizeType := Value;
DoChange;
end;
end;
procedure TIpHtmlRelSize.SetValue(const Value: Integer);
begin
if Value <> FValue then begin
FValue := Value;
DoChange;
end;
end;
{ TIpHtmlLength }
procedure TIpHtmlLength.DoChange;
begin
if Assigned(FChange) then
FChange(Self);
end;
function TIpHtmlLength.GetLengthValue: Integer;
begin
if (LengthType = hlAbsolute) and ScaleBitmaps then
Result := round(FLengthValue * Aspect)
else
Result := FLengthValue;
end;
procedure TIpHtmlLength.SetLengthType(const Value: TIpHtmlLengthType);
begin
if Value <> FLengthType then begin
FLengthType := Value;
DoChange;
end;
end;
procedure TIpHtmlLength.SetLengthValue(const Value: Integer);
begin
if Value <> FLengthValue then begin
FLengthValue := Value;
DoChange;
end;
end;
{ TIpHtmlMultiLength }
function TIpHtmlMultiLength.GetLengthValue: Integer;
begin
if (LengthType = hmlAbsolute) and ScaleBitmaps then
Result := round(FLengthValue * Aspect)
else
Result := FLengthValue;
end;
{ TIpHtmlMultiLengthList }
procedure TIpHtmlMultiLengthList.AddEntry(Value: TIpHtmlMultiLength);
begin
List.Add(Value);
end;
procedure TIpHtmlMultiLengthList.Clear;
begin
while List.Count > 0 do begin
TIpHtmlMultiLength(List[0]).Free;
List.Delete(0);
end;
end;
constructor TIpHtmlMultiLengthList.Create;
begin
inherited Create;
List := TFPList.Create;
end;
destructor TIpHtmlMultiLengthList.Destroy;
begin
inherited;
Clear;
List.Free;
end;
function TIpHtmlMultiLengthList.GetEntries: Integer;
begin
Result := List.Count;
end;
function TIpHtmlMultiLengthList.GetValues(
Index: Integer): TIpHtmlMultiLength;
begin
Result := TIpHtmlMultiLength(List[Index]);
end;
{ TIntArr }
destructor TIntArr.Destroy;
begin
inherited;
Freemem(InternalIntArr);
end;
function TIntArr.GetValue(Index: Integer): Integer;
begin
if (Index < 0) or (Index >= IntArrSize) then
Result := 0
else
Result := InternalIntArr^[Index];
end;
procedure TIntArr.SetValue(Index, Value: Integer);
var
p: ^Integer;
NewSize: Integer;
begin
if Index >= 0 then begin
if Index >= IntArrSize then begin
NewSize := IntArrSize;
repeat
Inc(NewSize, TINTARRGROWFACTOR);
until Index < NewSize;
{code below does not check if InternalIntArr<>nil}
ReallocMem(InternalIntArr,NewSize * sizeof(PtrInt));
p := pointer(InternalIntArr);
Inc(p, IntArrSize);
fillchar(p^, (NewSize - IntArrSize)*sizeOf(PtrInt), 0);
IntArrSize := NewSize;
end;
InternalIntArr^[Index] := Value;
end;
end;
{ TRectArr }
destructor TRectArr.Destroy;
begin
inherited;
Freemem(InternalRectArr);
end;
function TRectArr.GetValue(Index: Integer): PRect;
begin
Assert(Self <> nil);
if (Index < 0) or (Index >= IntArrSize) then
Result := nil
else
Result := InternalRectArr^[Index];
end;
procedure TRectArr.SetValue(Index: Integer; Value: PRect);
var
P: Pointer;
NewSize: Integer;
begin
Assert(Self <> nil);
if Index >= 0 then begin
if Index >= IntArrSize then begin
NewSize := IntArrSize;
repeat
Inc(NewSize, TINTARRGROWFACTOR);
until Index < NewSize;
{code below does not check if InternalIntArr<>nil and set buggy IntArrSize}
ReallocMem(InternalRectArr,NewSize * sizeof(PtrInt));
P := pointer(InternalRectArr);
Inc(P, IntArrSize);
fillchar(p^, (NewSize - IntArrSize)*sizeOf(PtrInt), 0);
IntArrSize:=NewSize;
end;
InternalRectArr^[Index] := Value;
end;
end;
{ TRectRectArr }
procedure TRectRectArr.Delete(Index: Integer);
var
i: Integer;
begin
if (Index >= 0) and (Index < IntArrSize) then begin
Value[Index].Free;
for i := 1 to IntArrSize - 1 do
InternalRectRectArr[i-1] := InternalRectRectArr[i];
InternalRectRectArr[IntArrSize - 1] := nil;
end;
end;
destructor TRectRectArr.Destroy;
var
i: Integer;
begin
inherited;
for i := 0 to IntArrSize - 1 do
Delete(i);
if InternalRectRectArr <> nil then
Freemem(InternalRectRectArr);
end;
function TRectRectArr.GetValue(Index: Integer): TRectArr;
var
P: ^Pointer;
NewSize: Integer;
begin
if Index >= 0 then begin
if Index >= IntArrSize then begin
NewSize := IntArrSize;
repeat
Inc(NewSize, TINTARRGROWFACTOR);
until Index < NewSize;
{code below does not check if InternalIntArr<>nil and set buggy IntArrSize}
ReallocMem(InternalRectRectArr,NewSize * sizeof(PtrInt));
p := pointer(InternalRectRectArr);
Inc(p, IntArrSize);
fillchar(p^, (NewSize - IntArrSize)*sizeOf(PtrInt), 0);
IntArrSize:=NewSize;
end;
Result := InternalRectRectArr^[Index];
if Result = nil then begin
Result := TRectArr.Create;
InternalRectRectArr^[Index] := Result;
end;
end else
Result := nil;
end;
end.

View File

@ -6,7 +6,8 @@ interface
uses uses
Classes, SysUtils, Graphics, Classes, SysUtils, Graphics,
ipConst, ipUtils, ipHtmlUtils, ipHtmlProp, ipHtml, ipCSS; ipConst, ipUtils, ipHtmlTypes, ipHtmlUtils, ipHtmlProp, ipCSS, ipHtmlClasses,
ipHtml;
type type
TIpHtmlParser = class(TIpHtmlBasicParser) TIpHtmlParser = class(TIpHtmlBasicParser)

View File

@ -6,19 +6,9 @@ interface
uses uses
Classes, SysUtils, types, contnrs, Graphics, Classes, SysUtils, types, contnrs, Graphics,
IpConst, IpUtils; IpConst, IpUtils, IpHtmlTypes;
type type
TIpHtmlAlign = (haDefault, haLeft, haCenter, haRight, haJustify, haChar, haUnknown);
TIpHtmlVAlign = (hvaTop, hvaMiddle, hvaBottom);
TIpHtmlVAlign3 = (hva3Top, hva3Middle, hva3Bottom, hva3Baseline, hva3Default);
TIpHtmlElemMarginStyle = (
hemsAuto, // use default
hemsPx // pixel
);
TIpHtmlElemMargin = record TIpHtmlElemMargin = record
Style: TIpHtmlElemMarginStyle; Style: TIpHtmlElemMarginStyle;
Size: single; // negative values are not yet supported Size: single; // negative values are not yet supported

View File

@ -6,7 +6,8 @@ unit ipHtmlTableLayout;
interface interface
uses uses
types, Classes, LCLType, LCLIntf, IpHtml, iphtmlprop; types, Classes, LCLType, LCLIntf,
IpHtmlTypes, IpHtmlProp, IpHtml, IpHtmlClasses;
type type

View File

@ -0,0 +1,153 @@
unit IpHtmlTypes;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Types;
const
MAXINTS = 4096; {buffer size - this should be way more than needed}
TINTARRGROWFACTOR = 64;
IPMAXFRAMES = 256; {maximum number of frames in a single frameset}
DEFAULT_PRINTMARGIN = 0.5; {inches}
FONTSIZESVALUESARRAY : array[0..6] of integer = (8,10,12,14,18,24,36);
MAXWORDS = 65536;
DEFAULT_LINKS_UNDERLINED = false;
ZOOM_TO_FIT = 0;
ZOOM_TO_FIT_WIDTH = -1;
ZOOM_TO_FIT_HEIGHT = -2;
ShyChar = #1; {character used to represent soft-hyphen in strings}
NbspChar = #2; {character used to represent no-break space in strings}
NAnchorChar = #3 ; {character used to represent an Anchor }
NbspUtf8 = #194#160; {utf8 code of no-break space character}
LF = #10;
CR = #13;
type
TElementType = (
etWord, etObject, etSoftLF, etHardLF, etClearLeft, etClearRight,
etClearBoth, etIndent, etOutdent, etSoftHyphen
);
TIpHtmlAlign = (
haDefault, haLeft, haCenter, haRight, haJustify, haChar, haUnknown
);
TIpHtmlBreakClear = (
hbcNone, hbcLeft, hbcRight, hbcAll
);
TIpHtmlButtonType = (
hbtSubmit, hbtReset, hbtButton
);
TIpHtmlCellScope = (
hcsUnspec, hcsRow, hcsCol, hcsRowGroup, hcsColGroup
);
TIpHtmlDirection = (
hdLTR, hdRTL
);
TIpHtmlElemMarginStyle = (
hemsAuto, // use default
hemsPx // pixel
);
TIpHtmlFontStyles = (
hfsTT, hfsI, hfsB, hfsU, hfsSTRIKE, hfsS, hfsBIG, hfsSMALL, hfsSUB, hfsSUP
);
TIpHtmlFormMethod = (
hfmGet, hfmPost
);
TIpHtmlFrameProp = (
hfVoid, hfAbove, hfBelow, hfHSides, hfLhs, hfRhs, hfvSides, hfBox, hfBorder
);
TIpHtmlFrameScrolling = (
hfsAuto, hfsYes, hfsNo
);
TIpHtmlHeaderSize = 1..6;
TIpHtmlImageAlign = (
hiaTop, hiaMiddle, hiaBottom, hiaLeft, hiaRight, hiaCenter
);
TIpHtmlInputType = (
hitText, hitPassword, hitCheckbox, hitRadio, hitSubmit, hitReset,
hitFile, hitHidden, hitImage, hitButton
);
TIpHtmlLengthType = (
hlUndefined, hlAbsolute, hlPercent
);
TIpHtmlMapShape = (
hmsDefault, hmsRect, hmsCircle, hmsPoly
);
TIpHtmlOLStyle = (
olArabic, olLowerAlpha, olUpperAlpha, olLowerRoman, olUpperRoman
);
TIpHtmlPhraseStyle = (
hpsEM, hpsSTRONG, hpsDFN, hpsCODE, hpsSAMP, hpsKBD, hpsVAR, hpsCITE,
hpsABBR, hpsACRONYM
);
TIpHtmlObjectValueType = (
hovtData, hovtRef, hovtObject
);
TIpHtmlPixelsType = (
hpUndefined, hpAbsolute
);
TIpHtmlRenderDevice = (
rdScreen, rdPrinter, rdPreview
);
TIpHtmlRules = (
hrNone, hrGroups, hrRows, hrCols, hrAll
);
TIpHtmlULType = (
ulDisc, ulSquare, ulCircle
);
TIpHtmlVAlign = (
hvaTop, hvaMiddle, hvaBottom
);
TIpHtmlVAlign3 = (
hva3Top, hva3Middle, hva3Bottom, hva3Baseline, hva3Default
);
TIpHtmlVAlignment2 = (
hva2Top, hva2Bottom, hva2Left, hva2Right
);
TIpScrollAction = (
hsaHome, hsaEnd, hsaPgUp, hsaPgDn, hsaLeft, hsaRight, hsaUp, hsaDown
);
var
// true during print preview only, public to let print preview unit access it
ScaleBitmaps: Boolean = False;
ScaleFonts : Boolean = False;
Aspect: Double = 1.0;
BWPrinter: Boolean;
implementation
end.

View File

@ -6,15 +6,7 @@ interface
uses uses
Classes, SysUtils, Graphics, Classes, SysUtils, Graphics,
IpHtmlProp; IpHtmlTypes, IpHtmlProp;
const
ShyChar = #1; {character used to represent soft-hyphen in strings}
NbspChar = #2; {character used to represent no-break space in strings}
NAnchorChar = #3 ; {character used to represent an Anchor }
NbspUtf8 = #194#160; {utf8 code of no-break space character}
LF = #10;
CR = #13;
function ColorFromString(S: String): TColor; function ColorFromString(S: String): TColor;
function TryColorFromString(S: String; out AColor: TColor; out AErrMsg: String): Boolean; function TryColorFromString(S: String; out AColor: TColor; out AErrMsg: String): Boolean;

View File

@ -10,8 +10,7 @@ uses
athreads, athreads,
{$ENDIF} {$ENDIF}
Interfaces, // this includes the LCL widgetset Interfaces, // this includes the LCL widgetset
Forms, iprotest_unit, ipro_tests Forms, iprotest_unit, ipro_tests;
{ you can add units after this };
{$R *.res} {$R *.res}

View File

@ -25,7 +25,7 @@
<License Value="MPL - Mozilla public license <License Value="MPL - Mozilla public license
"/> "/>
<Version Major="1"/> <Version Major="1"/>
<Files Count="20"> <Files Count="22">
<Item1> <Item1>
<Filename Value="ipanim.pas"/> <Filename Value="ipanim.pas"/>
<UnitName Value="IpAnim"/> <UnitName Value="IpAnim"/>
@ -84,7 +84,7 @@
</Item13> </Item13>
<Item14> <Item14>
<Filename Value="iphtmlprop.pas"/> <Filename Value="iphtmlprop.pas"/>
<UnitName Value="iphtmlprop"/> <UnitName Value="IpHtmlProp"/>
</Item14> </Item14>
<Item15> <Item15>
<Filename Value="iphtmlblocklayout.pas"/> <Filename Value="iphtmlblocklayout.pas"/>
@ -110,6 +110,14 @@
<Filename Value="ipcss.pas"/> <Filename Value="ipcss.pas"/>
<UnitName Value="IpCSS"/> <UnitName Value="IpCSS"/>
</Item20> </Item20>
<Item21>
<Filename Value="iphtmlclasses.pas"/>
<UnitName Value="IpHtmlClasses"/>
</Item21>
<Item22>
<Filename Value="iphtmltypes.pas"/>
<UnitName Value="iphtmltypes"/>
</Item22>
</Files> </Files>
<CompatibilityMode Value="True"/> <CompatibilityMode Value="True"/>
<i18n> <i18n>

View File

@ -9,8 +9,9 @@ interface
uses uses
IpAnim, IpConst, Ipfilebroker, Iphttpbroker, IpHtml, IpMsg, IpStrms, IpAnim, IpConst, Ipfilebroker, Iphttpbroker, IpHtml, IpMsg, IpStrms,
IpUtils, IpHtmlTabList, iphtmlprop, ipHtmlBlockLayout, ipHtmlTableLayout, IpUtils, IpHtmlTabList, IpHtmlProp, ipHtmlBlockLayout, ipHtmlTableLayout,
IpHtmlParser, IpHtmlUtils, IpCSS, LazarusPackageIntf; IpHtmlParser, IpHtmlUtils, IpCSS, IpHtmlClasses, IpHtmlTypes,
LazarusPackageIntf;
implementation implementation