From 0fa334b61083c12da89ee9a83961c23bb9e344a9 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Fri, 15 Jul 2016 23:25:07 +0000 Subject: [PATCH] tvplanit: Less hints and warnings (mostly UTF8-UTF16 related). Cosmetic changes. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@4983 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../tvplanit/examples/fulldemo/demomain.lfm | 4 +- .../tvplanit/source/laz_visualplanit.lpk | 2 - components/tvplanit/source/vpbase.pas | 49 ++- components/tvplanit/source/vpcanvasutils.pas | 12 +- .../tvplanit/source/vpcontactgridpainter.pas | 13 +- components/tvplanit/source/vplocalize.pas | 5 + components/tvplanit/source/vpmisc.pas | 4 +- components/tvplanit/source/vpprtprv.pas | 4 +- components/tvplanit/source/vpxbase.pas | 17 +- components/tvplanit/source/vpxchrflt.pas | 154 ++++--- components/tvplanit/source/vpxmlds.pas | 5 +- components/tvplanit/source/vpxparsr.pas | 380 +++++++++--------- 12 files changed, 350 insertions(+), 299 deletions(-) diff --git a/components/tvplanit/examples/fulldemo/demomain.lfm b/components/tvplanit/examples/fulldemo/demomain.lfm index 8ad84ab11..7dd0f3d16 100644 --- a/components/tvplanit/examples/fulldemo/demomain.lfm +++ b/components/tvplanit/examples/fulldemo/demomain.lfm @@ -1,7 +1,7 @@ object MainForm: TMainForm - Left = 307 + Left = 301 Height = 600 - Top = 312 + Top = 177 Width = 900 Caption = 'Turbo Power VisualPlanIt Demo' ClientHeight = 580 diff --git a/components/tvplanit/source/laz_visualplanit.lpk b/components/tvplanit/source/laz_visualplanit.lpk index 35e3b53ad..19e1ea2be 100644 --- a/components/tvplanit/source/laz_visualplanit.lpk +++ b/components/tvplanit/source/laz_visualplanit.lpk @@ -8,8 +8,6 @@ - - diff --git a/components/tvplanit/source/vpbase.pas b/components/tvplanit/source/vpbase.pas index c6a221f97..e90323507 100644 --- a/components/tvplanit/source/vpbase.pas +++ b/components/tvplanit/source/vpbase.pas @@ -105,7 +105,10 @@ type private seFilePos : Longint; public - constructor CreateError(const FilePos: Longint; const Reason: string); + constructor CreateError(const FilePos: Longint; const Reason: DOMString); overload; + {$IFDEF FPC} + constructor CreateError(const FilePos: Longint; const Reason: String); overload; + {$ENDIF} property FilePos: Longint read seFilePos; end; @@ -115,7 +118,10 @@ type feLine: Longint; feLinePos: Longint; public - constructor CreateError(const FilePos, Line, LinePos: Longint; const Reason: string); + constructor CreateError(const FilePos, Line, LinePos: Longint; const Reason: DOMstring); overload; + {$IFDEF FPC} + constructor CreateError(const FilePos, Line, LinePos: Longint; const Reason: string); overload; + {$ENDIF} property Reason : DOMString read feReason; property Line: Longint read feLine; property LinePos: Longint read feLinePos; @@ -123,7 +129,10 @@ type EVpParserError = class(EVpFilterError) public - constructor CreateError(Line, LinePos: Longint; const Reason: String); + constructor CreateError(Line, LinePos: Longint; const Reason: DOMString); overload; + {$IFDEF FPC} + constructor CreateError(Line, LinePos: Longint; const Reason: String); overload; + {$ENDIF} end; { implements the Version property with its associated design time About box } @@ -366,17 +375,30 @@ uses { EAdStreamError } +constructor EVpStreamError.CreateError(const FilePos: Integer; + const Reason: DOMString); +begin + {$IFDEF FPC} + inherited Create(UTF8Encode(Reason)); + {$ELSE} + inherited Create(Reason); + {$ENDIF} + seFilePos := FilePos; +end; + +{$IFDEF FPC} constructor EVpStreamError.CreateError(const FilePos: Integer; const Reason: String); begin inherited Create(Reason); seFilePos := FilePos; end; +{$ENDIF} { EAdFilterError } constructor EVpFilterError.CreateError(const FilePos, Line, LinePos: Integer; - const Reason: string); + const Reason: DOMString); begin inherited CreateError(FilePos, Reason); feLine := Line; @@ -384,13 +406,32 @@ begin feReason := Reason; end; +{$IFDEF FPC} +constructor EVpFilterError.CreateError(const FilePos, Line, LinePos: Integer; + const Reason: String); +begin + feReason := UTF8DEcode(Reason); + inherited CreateError(FilePos, feReason); + feLine := Line; + feLinePos := LinePos; +end; +{$ENDIF} + { EAdParserError } +constructor EVpParserError.CreateError(Line, LinePos: Integer; + const Reason: DOMString); +begin + inherited CreateError(FilePos, Line, LinePos, Reason); +end; + +{$IFDEF FPC} constructor EVpParserError.CreateError(Line, LinePos: Integer; const Reason: String); begin inherited CreateError(FilePos, Line, LinePos, Reason); end; +{$ENDIF} (*****************************************************************************) { TVpCustomControl } diff --git a/components/tvplanit/source/vpcanvasutils.pas b/components/tvplanit/source/vpcanvasutils.pas index ffbd78bb0..f022dc7c6 100644 --- a/components/tvplanit/source/vpcanvasutils.pas +++ b/components/tvplanit/source/vpcanvasutils.pas @@ -149,10 +149,12 @@ type function RGBToTColor(Red, Green, Blue: Byte): TColor; procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte); procedure CachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray); + { function GetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; x, y: Integer): TColor; procedure SetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; x, y: Integer; AColor: TColor); + } property Viewport: TRect read FViewport write FViewport; published @@ -307,12 +309,13 @@ procedure TColorToRGB(Color: TColor; var Red, Green, Blue: Byte); procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray); +{ function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; x, y: Integer): TColor; procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; x, y: Integer; AColor: TColor); - +} function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; const Viewport: TRect; ARect: TRect; AString: string): Integer; @@ -625,7 +628,7 @@ procedure TPSCachePalette(ABitmap: TBitmap; var PaletteEntries: TVpPaletteArray) begin VpRotatedCanvas.CachePalette(ABitmap, PaletteEntries); end; - +{ function TPSGetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; x, y: Integer): TColor; begin @@ -637,7 +640,7 @@ procedure TPSSetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; begin VpRotatedCanvas.SetBmpPixel(ABitmap, PaletteCache, x, y, AColor); end; - +} function RenderTextToRect(ACanvas: TCanvas; const Angle: TVpRotationAngle; const Viewport: TRect; ARect: TRect; AString: string): Integer; begin @@ -1257,6 +1260,7 @@ begin GetPaletteEntries(ABitmap.Palette, 0, PaletteSize, PaletteEntries); end; +(* // Fast scanline based pixel access function TVpExCanvas.GetBmpPixel(ABitmap: TBitmap; PaletteCache: TVpPaletteArray; x, y: Integer): TColor; @@ -1437,7 +1441,7 @@ begin end; } end; - +*) { TVpLineWrapper ************************************************************ } diff --git a/components/tvplanit/source/vpcontactgridpainter.pas b/components/tvplanit/source/vpcontactgridpainter.pas index f0b3d266f..2e4548acf 100644 --- a/components/tvplanit/source/vpcontactgridpainter.pas +++ b/components/tvplanit/source/vpcontactgridpainter.pas @@ -220,13 +220,22 @@ var TmpBmp: TBitmap; TmpCon: TVpContact; Col, RecsInCol: Integer; - HeadRect, AddrRect, CSZRect, Phone1Rect, Phone2Rect, Phone3Rect: TRect; - Phone4Rect, Phone5Rect, WholeRect, CompanyRect, EMailRect: TRect; + HeadRect: TRect; + WholeRect: TRect; TmpBmpRect: TRect; TextColWidth: Integer; TextXOffset: Integer; TextYOffset: Integer; oldCol1RecCount: Integer; + AddrRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + CSZRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + CompanyRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + EMailRect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + Phone1Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + Phone2Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + Phone3Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + Phone4Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); + Phone5Rect: TRect = (Left:0; Top:0; Right:0; Bottom:0); begin oldCol1RecCount := TVpContactGridOpener(FContactGrid).cgCol1RecCount; TVpContactGridOpener(FContactGrid).FVisibleContacts := 0; diff --git a/components/tvplanit/source/vplocalize.pas b/components/tvplanit/source/vplocalize.pas index 4b41c6bea..92abc837e 100644 --- a/components/tvplanit/source/vplocalize.pas +++ b/components/tvplanit/source/vplocalize.pas @@ -637,8 +637,13 @@ var begin Unused(oOwner, bSpecified); Item := TVpAttributeItem(FAttributes.Add); + {$IFDEF DELPHI} Item.Name := sName; Item.Value := sValue; + {$ELSE} + Item.Name := UTF8Encode(sName); + Item.Value := UTF8Encode(sValue); + {$ENDIF} end; procedure TVpLocalization.xmlLocalizeEndElement (oOwner : TObject; diff --git a/components/tvplanit/source/vpmisc.pas b/components/tvplanit/source/vpmisc.pas index 95fb99893..4822d27b7 100644 --- a/components/tvplanit/source/vpmisc.pas +++ b/components/tvplanit/source/vpmisc.pas @@ -602,14 +602,14 @@ end; function GetButtonWidth(AButton: TButton): Integer; const - MARGIN = 16; + MARGIN = 24; var canvas: TControlCanvas; begin canvas := TControlCanvas.Create; canvas.Control := AButton; canvas.Font.Assign(AButton.Font); - Result := canvas.TextWidth(AButton.Caption) + 24 * Screen.PixelsPerInch div DesignTimeDPI; + Result := canvas.TextWidth(AButton.Caption) + MARGIN * Screen.PixelsPerInch div DesignTimeDPI; end; function GetRealFontHeight(AFont: TFont): Integer; diff --git a/components/tvplanit/source/vpprtprv.pas b/components/tvplanit/source/vpprtprv.pas index 6f6049fa7..d1f87ac02 100644 --- a/components/tvplanit/source/vpprtprv.pas +++ b/components/tvplanit/source/vpprtprv.pas @@ -343,9 +343,9 @@ begin with Params do begin Style := Style or WS_TABSTOP; if FNeedHScroll then - Style := Longint (Style) or WS_HSCROLL; + Style := Style or WS_HSCROLL; if FNeedVScroll then - Style := Longint (Style) or WS_VSCROLL; + Style := Style or WS_VSCROLL; end; end; diff --git a/components/tvplanit/source/vpxbase.pas b/components/tvplanit/source/vpxbase.pas index 67934dba9..7b94dc828 100644 --- a/components/tvplanit/source/vpxbase.pas +++ b/components/tvplanit/source/vpxbase.pas @@ -55,7 +55,7 @@ type method.} TVpMemoryStream = class(TMemoryStream) public - procedure SetPointer(Ptr : Pointer; Size : Longint); + procedure SetPointer(Ptr: Pointer; Size: Longint); end; {$IFDEF LCL} @@ -63,11 +63,10 @@ type {$ELSE} TVpFileStream = class(TFileStream) {$ENDIF} - FFileName : string; + FFileName: string; public - constructor CreateEx(Mode : Word; const FileName : string); - - property Filename : string read FFileName; + constructor CreateEx(Mode: Word; const FileName: string); + property Filename: string read FFileName; end; { Utility methods } @@ -83,7 +82,7 @@ function VpUcs4ToWideChar(const aInChar : TVpUcs4Char; function VpUtf16ToUcs4(aInChI, aInChII : DOMChar; var aOutCh : TVpUcs4Char; - var aBothUsed : Boolean) : Boolean; + out aBothUsed : Boolean) : Boolean; function VpUcs4ToUtf8(aInCh : TVpUcs4Char; var aOutCh : TVpUtf8Char) : Boolean; function VpUtf8ToUcs4(const aInCh : TVpUtf8Char; @@ -120,7 +119,11 @@ uses {== Utility methods ==================================================} function VpPos(const aSubStr, aString : DOMString) : Integer; begin + {$IFDEF DELPHI} Result := AnsiPos(aSubStr, aString); + {$ELSE} + Result := Pos(aSubStr, aString); + {$ENDIF} end; {--------} function VpRPos(const sSubStr, sTerm : DOMString) : Integer; @@ -190,7 +193,7 @@ end; function VpUtf16ToUcs4(aInChI, aInChII : DOMChar; var aOutCh : TVpUcs4Char; - var aBothUsed : Boolean) : Boolean; + out aBothUsed : Boolean) : Boolean; begin aBothUsed := False; if (aInChI < #$D800) or (aInChI > #$DFFF) then begin diff --git a/components/tvplanit/source/vpxchrflt.pas b/components/tvplanit/source/vpxchrflt.pas index 2994bcb03..ac5a2f7b3 100644 --- a/components/tvplanit/source/vpxchrflt.pas +++ b/components/tvplanit/source/vpxchrflt.pas @@ -119,32 +119,25 @@ type TVpOutCharFilter = class(TVpBaseCharFilter) protected - FFormat : TVpStreamFormat; - FSetUTF8Sig : Boolean; + FFormat: TVpStreamFormat; + FSetUTF8Sig: Boolean; protected - function csGetSize : LongInt; override; - procedure csPutUtf8Char(const aCh : TVpUcs4Char); - procedure csSetFormat(const aValue : TVpStreamFormat); override; + function csGetSize: LongInt; override; + procedure csPutUtf8Char(const aCh: TVpUcs4Char); + procedure csSetFormat(const aValue: TVpStreamFormat); override; procedure csWriteBuffer; public - constructor Create(aStream : TStream; const aBufSize : Longint); override; + constructor Create(aStream: TStream; const aBufSize: Longint); override; destructor Destroy; override; - procedure PutUCS4Char(aCh : TVpUcs4Char); - function PutChar(aCh1, aCh2 : DOMChar; - var aBothUsed : Boolean) : Boolean; - function PutString(const aText : DOMString) : Boolean; + procedure PutUCS4Char(aCh: TVpUcs4Char); + function PutChar(aCh1, aCh2: DOMChar; out aBothUsed: Boolean): Boolean; + function PutString(const aText: DOMString): Boolean; function Position : integer; - property Format : TVpStreamFormat - read FFormat - write csSetFormat; - property WriteUTF8Signature : Boolean - read FSetUTF8Sig - write FSetUTF8Sig; - property Size : LongInt - read csGetSize; - + property Format: TVpStreamFormat read FFormat write csSetFormat; + property WriteUTF8Signature: Boolean read FSetUTF8Sig write FSetUTF8Sig; + property Size: LongInt read csGetSize; end; @@ -372,12 +365,13 @@ begin if (FBuffer[0] = #$FE) and (FBuffer[1] = #$FF) then begin FFormat := sfUTF16BE; FBufPos := 2; - end else if (FBuffer[0] = #$FF) and (FBuffer[1] = #$FE) then begin + end else + if (FBuffer[0] = #$FF) and (FBuffer[1] = #$FE) then begin FFormat := sfUTF16LE; FBufPos := 2; - end else if (FBuffer[0] = #$EF) and - (FBuffer[1] = #$BB) and - (FBuffer[2] = #$BF) then begin + end else + if (FBuffer[0] = #$EF) and (FBuffer[1] = #$BB) and (FBuffer[2] = #$BF) then + begin FFormat := sfUTF8; FBufPos := 3; end else @@ -386,14 +380,14 @@ begin FFormat := sfUTF8; end; {--------} -procedure TVpInCharFilter.csPushCharPrim(aCh : TVpUcs4Char); +procedure TVpInCharFilter.csPushCharPrim(aCh: TVpUcs4Char); begin Assert(FUCS4Char = TVpUCS4Char(VpNullChar)); {put the char into the buffer} FUCS4Char := aCh; end; {--------} -procedure TVpInCharFilter.csSetFormat(const aValue : TVpStreamFormat); +procedure TVpInCharFilter.csSetFormat(const aValue: TVpStreamFormat); begin {we do not allow the UTF16 formats to be changed since they were well defined by the BOM at the start of the stream but all other @@ -404,8 +398,7 @@ begin FFormat := aValue; end; {--------} -procedure TVpInCharFilter.csGetChar(var aCh : TVpUcs4Char; - var aIsLiteral : Boolean); +procedure TVpInCharFilter.csGetChar(var aCh: TVpUcs4Char; var aIsLiteral: Boolean); begin {get the next character; for an EOF raise an exception} csGetCharPrim(aCh, aIsLiteral); @@ -419,7 +412,7 @@ begin csAdvanceLinePos; end; {--------} -function TVpInCharFilter.TryRead(const S : array of Longint) : Boolean; +function TVpInCharFilter.TryRead(const S: array of Longint): Boolean; var Idx : Longint; Ch : TVpUcs4Char; @@ -489,10 +482,10 @@ begin FEOF := True; end; {--------} -function TVpInCharFilter.ReadChar : DOMChar; +function TVpInCharFilter.ReadChar: DOMChar; var - Ch : TVpUCS4Char; - IL : Boolean; + Ch: TVpUCS4Char = 0; // to silence the compiler + IL: Boolean = false; // dto. begin if (FLastChar = '') or (FLastChar = #0) then begin // wp: added #0 csGetChar(Ch, IL); @@ -500,8 +493,7 @@ begin Dec(FLinePos); FLastChar := Result; if (FUCS4Char <> TVpUCS4Char(VpNullChar)) then - if (Format = sfUTF16LE) or - (Format = sfUTF16BE) then + if (Format = sfUTF16LE) or (Format = sfUTF16BE) then Dec(FBufPos, 2) else if FBufPos > 0 then Dec(FBufPos, 1); @@ -526,15 +518,15 @@ begin inherited Destroy; end; {--------} -function TVpOutCharFilter.csGetSize : LongInt; +function TVpOutCharFilter.csGetSize: LongInt; begin Result := FStream.Size + FBufPos; end; {--------} -procedure TVpOutCharFilter.csPutUtf8Char(const aCh : TVpUcs4Char); +procedure TVpOutCharFilter.csPutUtf8Char(const aCh: TVpUcs4Char); var - UTF8 : TVpUtf8Char; - i : integer; + UTF8: TVpUtf8Char; + i: integer; begin if not VpUcs4ToUtf8(aCh, UTF8) then raise EVpStreamError.CreateError(FStream.Position, sUCS_U8ConverErr); @@ -546,44 +538,50 @@ begin end; end; {--------} -procedure TVpOutCharFilter.csSetFormat(const aValue : TVpStreamFormat); +procedure TVpOutCharFilter.csSetFormat(const aValue: TVpStreamFormat); var - TooLate : Boolean; + TooLate: Boolean; begin + case Format of + sfUTF8: + TooLate := (FSetUTF8Sig and (Position > 3)) or ((not FSetUTF8Sig) and (Position > 0)); + sfUTF16LE: + TooLate := (Position > 2); + sfUTF16BE: + TooLate := (Position > 2); + sfISO88591: + TooLate := (Position > 0); + else + TooLate := true; + end; + + if not TooLate then begin + FBufPos := 0; + FFormat := aValue; case Format of - sfUTF8 : TooLate := (FSetUTF8Sig and (Position > 3)) or - ((not FSetUTF8Sig) and (Position > 0)); - sfUTF16LE : TooLate := (Position > 2); - sfUTF16BE : TooLate := (Position > 2); - sfISO88591 : TooLate := (Position > 0); + sfUTF8: + if FSetUTF8Sig then begin + FBuffer[0] := #$EF; + FBuffer[1] := #$BB; + FBuffer[2] := #$BF; + FBufPos := 3; + end; + sfUTF16LE : + begin + FBuffer[0] := #$FF; + FBuffer[1] := #$FE; + FBufPos := 2; + end; + sfUTF16BE : + begin + FBuffer[0] := #$FE; + FBuffer[1] := #$FF; + FBufPos := 2; + end; else - TooLate := true; - end; - if not TooLate then begin FBufPos := 0; - FFormat := aValue; - case Format of - sfUTF8: - if FSetUTF8Sig then begin - FBuffer[0] := #$EF; - FBuffer[1] := #$BB; - FBuffer[2] := #$BF; - FBufPos := 3; - end; - sfUTF16LE : begin - FBuffer[0] := #$FF; - FBuffer[1] := #$FE; - FBufPos := 2; - end; - sfUTF16BE : begin - FBuffer[0] := #$FE; - FBuffer[1] := #$FF; - FBufPos := 2; - end; - else - FBufPos := 0; - end; end; + end; end; {--------} procedure TVpOutCharFilter.csWriteBuffer; @@ -592,27 +590,27 @@ begin FBufPos := 0; end; {--------} -procedure TVpOutCharFilter.PutUCS4Char(aCh : TVpUcs4Char); +procedure TVpOutCharFilter.PutUCS4Char(aCh: TVpUcs4Char); begin case Format of - sfUTF8 : csPutUTF8Char(aCh); + sfUTF8: csPutUTF8Char(aCh); end; end; {--------} -function TVpOutCharFilter.PutChar(aCh1, aCh2 : DOMChar; - var aBothUsed : Boolean) : Boolean; +function TVpOutCharFilter.PutChar(aCh1, aCh2: DOMChar; + out aBothUsed: Boolean): Boolean; var - OutCh : TVpUCS4Char; + OutCh: TVpUCS4Char; begin Result := VpUTF16toUCS4(aCh1, aCh2, OutCh, aBothUsed); if Result then PutUCS4Char(OutCh); end; {--------} -function TVpOutCharFilter.PutString(const aText : DOMString) : Boolean; +function TVpOutCharFilter.PutString(const aText: DOMString): Boolean; var - aBothUsed : Boolean; - aLen, aPos : Integer; + aBothUsed: Boolean; + aLen, aPos: Integer; begin aLen := Length(aText); aPos := 1; @@ -630,7 +628,7 @@ begin end; end; {--------} -function TVpOutCharFilter.Position : integer; +function TVpOutCharFilter.Position: Integer; begin Result := FStreamPos + FBufPos; end; diff --git a/components/tvplanit/source/vpxmlds.pas b/components/tvplanit/source/vpxmlds.pas index 325bbb850..beb6c5112 100644 --- a/components/tvplanit/source/vpxmlds.pas +++ b/components/tvplanit/source/vpxmlds.pas @@ -231,9 +231,8 @@ end; function TVpXmlDatastore.CreateStoreNode(ADoc: TDOMDocument): TDOMNode; var L: TStrings; - i, j: Integer; - node, prevnode: TDOMNode; - rootnode: TDOMNode; + i: Integer; + node: TDOMNode; appending: Boolean; {%H-}nodename: String; begin diff --git a/components/tvplanit/source/vpxparsr.pas b/components/tvplanit/source/vpxparsr.pas index 69def3775..8ca3db2ed 100644 --- a/components/tvplanit/source/vpxparsr.pas +++ b/components/tvplanit/source/vpxparsr.pas @@ -182,8 +182,8 @@ type procedure ParseXMLDeclaration; procedure PopDocument; procedure PushDocument; - procedure PushString(const sVal : DOMString); - function ReadChar(const UpdatePos : Boolean) : DOMChar; + procedure PushString(const sVal: DOMString); + function ReadChar(const UpdatePos: Boolean): DOMChar; procedure ReadExternalIds(bInNotation : Boolean; var sIds : StringIds); function ReadLiteral(wFlags : Integer; @@ -377,70 +377,45 @@ type {== TVpNotationInfo ==================================================} TVpNotationInfo = class(TObject) private - FPublicId : DOMString; - FSystemId : DOMString; + FPublicId: DOMString; + FSystemId: DOMString; public - property PublicId : DOMString - read FPublicId - write FPublicId; - - property SystemId : DOMString - read FSystemId - write FSystemId; + property PublicId: DOMString read FPublicId write FPublicId; + property SystemId: DOMString read FSystemId write FSystemId; end; + {== TVpAttributeInfo =================================================} TVpAttributeInfo = class(TObject) private - FType : Integer; - FValue : DOMString; - FValueType : Integer; - FEnum : DOMString; - FLookup : DOMString; + FType: Integer; + FValue: DOMString; + FValueType: Integer; + FEnum: DOMString; + FLookup: DOMString; public - property AttrType : Integer - read FType - write FType; - - property Enum : DOMString - read FEnum - write FEnum; - - property Lookup : DOMString - read FLookup - write FLookup; - - property Value : DOMString - read FValue - write FValue; - - property ValueType : Integer - read FValueType - write FValueType; + property AttrType: Integer read FType write FType; + property Enum: DOMString read FEnum write FEnum; + property Lookup: DOMString read FLookup write FLookup; + property Value: DOMString read FValue write FValue; + property ValueType: Integer read FValueType write FValueType; end; + {== TVpElementInfo ===================================================} TVpElementInfo = class(TObject) private - FAttributeList : TStringList; - FContentType : Integer; - FContentModel : DOMString; + FAttributeList: TStringList; + FContentType: Integer; + FContentModel: DOMString; public constructor Create; destructor Destroy; override; + procedure SetAttribute(const sName: DOMString; oAttrInfo: TVpAttributeInfo); - procedure SetAttribute(const sName : DOMString; - oAttrInfo : TVpAttributeInfo); - - property AttributeList : TStringList - read FAttributeList; - - property ContentModel : DOMString - read FContentModel - write FContentModel; - - property ContentType : Integer - read FContentType - write FContentType; + property AttributeList: TStringList read FAttributeList; + property ContentModel: DOMString read FContentModel write FContentModel; + property ContentType: Integer read FContentType write FContentType; end; + {=== TVpElementInfo ==================================================} constructor TVpElementInfo.Create; begin @@ -462,20 +437,28 @@ begin inherited Destroy; end; {--------} -procedure TVpElementInfo.SetAttribute(const sName : DOMString; - oAttrInfo : TVpAttributeInfo); +procedure TVpElementInfo.SetAttribute(const sName: DOMString; + oAttrInfo: TVpAttributeInfo); var - wIdx : Integer; + wIdx: Integer; begin if FAttributeList = nil then begin FAttributeList := TStringList.Create; FAttributeList.Sorted := True; wIdx := -1 end else + {$IFDEF DELPHI} wIdx := FAttributeList.IndexOf(sName); + {$ELSE} + wIdx := FAttributeList.IndexOf(UTF8Encode(sName)); + {$ENDIF} if wIdx < 0 then + {$IFDEF DELPHI} FAttributeList.AddObject(sName, oAttrInfo) + {$ELSE} + FAttributeList.AddObject(UTF8Encode(sName), oAttrInfo) + {$ENDIF} else begin TVpAttributeInfo(FAttributeList.Objects[wIdx]).Free; FAttributeList.Objects[wIdx] := oAttrInfo; @@ -553,19 +536,22 @@ end; {--------} procedure TVpParser.CheckParamEntityNesting(const aString : DOMString); var - OpenPos : Integer; - ClosePos : Integer; + OpenPos: Integer; + ClosePos: Integer; + errMsg: DOMString; begin OpenPos := VpPos('(', aString); ClosePos := VpPos(')', aString); - if (((OpenPos <> 0) and - (ClosePos = 0)) or - ((ClosePos <> 0) and - (OpenPos = 0))) then - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sBadParamEntNesting + - aString); + if ((OpenPos <> 0) and (ClosePos = 0)) or + ((ClosePos <> 0) and (OpenPos = 0)) then + begin + {$IFDEF DELPHI} + errMsg := sBadParamEntNesting + aString; + {$ELSE} + errMsg := UTF8Decode(sBadParamEntNesting) + aString; + {$ENDIF} + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, errMsg); + end; end; {--------} procedure TVpParser.Cleanup; @@ -669,40 +655,46 @@ begin Result := FErrors.Count; end; {--------} -function TVpParser.GetErrorMsg(wIdx : Integer) : DOMString; +function TVpParser.GetErrorMsg(wIdx: Integer): DOMString; begin + {$IFDEF DELPHI} Result := sIndexOutOfBounds; - if (wIdx >= 0) and - (wIdx < FErrors.Count) then + if (wIdx >= 0) and (wIdx < FErrors.Count) then Result := FErrors[wIdx]; + {$ELSE} + Result := UTF8Decode(sIndexOutOfBounds); + if (wIdx >= 0) and (wIdx < FErrors.Count) then + Result := UTF8Decode(FErrors[wIdx]); + {$ENDIF} end; {--------} -function TVpParser.DeclaredAttributes(const sName : DOMString; - aIdx : Integer) - : TStringList; +function TVpParser.DeclaredAttributes(const sName: DOMString; + aIdx: Integer): TStringList; begin Unused(sName); - if aIdx < 0 then Result := nil else Result := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList; end; {--------} -function TVpParser.GetAttributeDefaultValueType(const sElemName, - sAttrName : DOMString) - : Integer; +function TVpParser.GetAttributeDefaultValueType( + const sElemName, sAttrName: DOMString): Integer; var - wIdx : Integer; - oAttrList : TStringList; - oAttr : TVpAttributeInfo; + wIdx: Integer; + oAttrList: TStringList; + oAttr: TVpAttributeInfo; begin Result := ATTRIBUTE_DEFAULT_UNDECLARED; wIdx := GetElementIndexOf(sElemName); if wIdx >= 0 then begin oAttrList := TVpElementInfo(FElementInfo.Objects[wIdx]).AttributeList; if oAttrList <> nil then begin + {$IFDEF DELPHI} wIdx := oAttrList.IndexOf(sAttrName); + {$ELSE} + wIdx := oAttrList.IndexOf(UTF8Encode(sAttrName)); + {$ENDIF} if wIdx >= 0 then begin oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]); Result := oAttr.AttrType; @@ -711,15 +703,13 @@ begin end; end; {--------} -function TVpParser.GetAttributeExpandedValue(const sElemName, - sAttrName : DOMString; - aIdx : Integer) - : DOMString; +function TVpParser.GetAttributeExpandedValue(const sElemName, sAttrName: DOMString; + aIdx: Integer): DOMString; var - wIdx : Integer; - oAttrList : TStringList; - oAttr : TVpAttributeInfo; - HasEntRef : Boolean; + wIdx: Integer; + oAttrList: TStringList; + oAttr: TVpAttributeInfo; + HasEntRef: Boolean; begin Unused(sElemName); @@ -728,16 +718,17 @@ begin if aIdx >= 0 then begin oAttrList := TVpElementInfo(FElementInfo.Objects[aIdx]).AttributeList; if oAttrList <> nil then begin + {$IFDEF DELPHI} wIdx := oAttrList.IndexOf(sAttrName); + {$ELSE} + wIdx := oAttrList.IndexOf(UTF8Encode(sAttrName)); + {$ENDIF} if wIdx >= 0 then begin oAttr := TVpAttributeInfo(oAttrList.Objects[wIdx]); - if (oAttr.Lookup = '') and - (oAttr.Value <> '') then begin + if (oAttr.Lookup = '') and (oAttr.Value <> '') then + begin PushString('"' + oAttr.Value + '"'); - oAttr.Lookup := ReadLiteral(LIT_NORMALIZE or - LIT_CHAR_REF or - LIT_ENTITY_REF, - HasEntRef); + oAttr.Lookup := ReadLiteral(LIT_NORMALIZE or LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef); SkipWhitespace(True); end; Result := oAttr.Lookup; @@ -746,9 +737,8 @@ begin end; end; {--------} -function TVpParser.GetElementContentType(const sName : DOMString; - aIdx : Integer) - : Integer; +function TVpParser.GetElementContentType(const sName: DOMString; + aIdx: Integer): Integer; begin Unused(sName); if aIdx < 0 then @@ -757,18 +747,21 @@ begin Result := TVpElementInfo(FElementInfo.Objects[aIdx]).ContentType; end; {--------} -function TVpParser.GetElementIndexOf(const sElemName : DOMString) - : Integer; +function TVpParser.GetElementIndexOf(const sElemName: DOMString): Integer; begin + {$IFDEF DELPHI} Result := FElementInfo.IndexOf(sElemName); + {$ELSE} + Result := FElementInfo.IndexOf(UTF8Encode(sElemName)); + {$ENDIF} end; {--------} -function TVpParser.GetEntityIndexOf(const sEntityName : DOMString; - aPEAllowed : Boolean) - : Integer; +function TVpParser.GetEntityIndexOf(const sEntityName: DOMString; + aPEAllowed: Boolean): Integer; begin for Result := 0 to FEntityInfo.Count - 1 do - if FEntityInfo[Result] = sEntityName then begin + if FEntityInfo[Result] = {$IFDEF DELPHI}sEntityName{$ELSE}UTF8Encode(sEntityName){$ENDIF} + then begin if (not aPEAllowed) then begin if (not TVpEntityInfo(FEntityInfo.Objects[Result]).IsParameterEntity) then Exit; @@ -850,12 +843,10 @@ begin end; end; {--------} -function TVpParser.GetExternalTextEntityValue(const sName, - sPublicId : DOMString; - sSystemId : DOMString) - : DOMString; +function TVpParser.GetExternalTextEntityValue(const sName, sPublicId: DOMString; + sSystemId: DOMString): DOMString; var - CompletePath : string; + CompletePath: string; begin DataBufferFlush; Result := ''; @@ -869,8 +860,7 @@ begin exit; PushDocument; - if (VpPos('/', sSystemID) = 0) and - (VpPos('\', sSystemID) = 0) then + if (VpPos('/', sSystemID) = 0) and (VpPos('\', sSystemID) = 0) then CompletePath := FCurrentPath + sSystemID else CompletePath := sSystemID; @@ -931,10 +921,9 @@ begin (cVal = #$0D) or (cVal = #$0A); end; {--------} -function TVpParser.LoadDataSource(sSrcName : string; - oErrors : TStringList) : Boolean; +function TVpParser.LoadDataSource(sSrcName: string; oErrors: TStringList): Boolean; var - aFileStream : TVpFileStream; + aFileStream: TVpFileStream; begin begin { Must be a local or network file. Eliminate file:// prefix. } @@ -1209,7 +1198,11 @@ begin FErrors.Clear; FIsStandAlone := False; FHasExternals := False; + {$IFDEF DELPHI} FUrl := sSource; + {$ELSE} + FUrl := UTF8Decode(sSource); + {$ENDIF} Result := LoadDataSource(sSource, FErrors); if Result then begin FFilter.FreeStream := True; @@ -1379,14 +1372,17 @@ end; procedure TVpParser.ParseEndTag; var sName : DOMString; + msg: DOMString; begin sName := ReadNameToken(True); - if sName <> FCurrentElement then - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sMismatchEndTag + - 'Start tag = "' + FCurrentElement + - '" End tag = "' + sName + '"'); + if sName <> FCurrentElement then begin + {$IFDEF DELPHI} + msg := sMismatchEndTag + 'Start tag = "' + FCurrentElement + '" End tag = "' + sName + '"'; + {$ELSE} + msg := UTF8Decode(sMismatchEndTag) + 'Start tag = "' + FCurrentElement + '" End tag = "' + sName + '"'; + {$ENDIF} + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg); + end; SkipWhitespace(True); Require(Xpc_BracketAngleRight); if Assigned(FOnEndElement) then @@ -1657,9 +1653,8 @@ var HasEntRef : Boolean; begin if FXMLDecParsed then - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sXMLDecNotAtBeg); + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sXMLDecNotAtBeg); + HasEntRef := False; SkipWhitespace(True); Require(Xpc_Version); @@ -1676,37 +1671,30 @@ begin Format(sInvalidXMLVersion, [VpXMLSpecification])); SkipWhitespace(True); - if TryRead(Xpc_Encoding) then begin - DatabufferAppend('encoding'); - ParseEq; - DataBufferAppend('="'); - Buffer := Buffer + ' ' + DataBufferToString; - sValue := ReadLiteral(LIT_CHAR_REF or - LIT_ENTITY_REF, - HasEntRef); - ValidateEncName(sValue); - Buffer := Buffer + sValue + '"'; - if CompareText(sValue, 'ISO-8859-1') = 0 then - FFilter.Format := sfISO88591; - SkipWhitespace(True); + if TryRead(Xpc_Encoding) then begin + DatabufferAppend('encoding'); + ParseEq; + DataBufferAppend('="'); + Buffer := Buffer + ' ' + DataBufferToString; + sValue := ReadLiteral(LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef); + ValidateEncName(sValue); + Buffer := Buffer + sValue + '"'; + if CompareText(sValue, 'ISO-8859-1') = 0 then + FFilter.Format := sfISO88591; + SkipWhitespace(True); end; - if TryRead(Xpc_Standalone) then begin - DatabufferAppend('standalone'); - ParseEq; - DatabufferAppend('="'); - Buffer := Buffer + ' ' + DataBufferToString; - sValue := ReadLiteral(LIT_CHAR_REF or - LIT_ENTITY_REF, - HasEntRef); - if (not ((sValue = 'yes') or - (sValue = 'no'))) then - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sInvStandAloneVal); - Buffer := Buffer + sValue + '"'; - FIsStandalone := sValue = 'yes'; - SkipWhitespace(True) + if TryRead(Xpc_Standalone) then begin + DatabufferAppend('standalone'); + ParseEq; + DatabufferAppend('="'); + Buffer := Buffer + ' ' + DataBufferToString; + sValue := ReadLiteral(LIT_CHAR_REF or LIT_ENTITY_REF, HasEntRef); + if (not ((sValue = 'yes') or (sValue = 'no'))) then + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sInvStandAloneVal); + Buffer := Buffer + sValue + '"'; + FIsStandalone := sValue = 'yes'; + SkipWhitespace(True) end; Require(Xpc_ProcessInstrEnd); @@ -1747,13 +1735,12 @@ begin end; end; {--------} -function TVpParser.ReadChar(const UpdatePos : Boolean) : DOMChar; +function TVpParser.ReadChar(const UpdatePos: Boolean) : DOMChar; begin Result := FFilter.ReadChar; - if ((Result = VpEndOfStream) and - (not IsEndDocument)) then + if (Result = VpEndOfStream) and (not IsEndDocument) then Result := FFilter.ReadChar; - if (UpdatePos) then + if UpdatePos then FFilter.SkipChar; end; {--------} @@ -1784,15 +1771,14 @@ begin end; end; {--------} -function TVpParser.ReadLiteral(wFlags : Integer; - var HasEntRef : Boolean) : DOMString; +function TVpParser.ReadLiteral(wFlags: Integer; var HasEntRef: Boolean): DOMString; var - TempStr : DOMString; - cDelim, - TempChar : DOMChar; - EntRefs : TStringList; - StackLevel : Integer; - CurrCharRef : Boolean; + TempStr: DOMString; + cDelim, TempChar: DOMChar; + EntRefs: TStringList; + StackLevel: Integer; + CurrCharRef: Boolean; + msg: DOMString; begin StackLevel := 0; CurrCharRef := False; @@ -1802,14 +1788,11 @@ begin if (cDelim <> '"') and (cDelim <> #39) and (cDelim <> #126) and - (cDelim <> #0) then - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sQuoteExpected); + (cDelim <> #0) + then + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, sQuoteExpected); TempChar := ReadChar(False); - while (not IsEndDocument) and - ((CurrCharRef) or - (TempChar <> cDelim)) do begin + while (not IsEndDocument) and ((CurrCharRef) or (TempChar <> cDelim)) do begin if (TempChar = #$0A) then begin TempChar := ' '; end else if (TempChar = #$0D) then @@ -1833,7 +1816,8 @@ begin (TempStr <> 'gt') and (TempStr <> 'amp') and (TempStr <> 'apos') and - (TempStr <> 'quot') then begin + (TempStr <> 'quot') then + begin if (not Assigned(EntRefs)) then begin EntRefs := TStringList.Create; EntRefs.Sorted := True; @@ -1850,10 +1834,12 @@ begin except on E:EStringListError do begin EntRefs.Free; - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sCircularEntRef + - TempChar); + {$IFDEF DELPHI} + msg := sCircularEntRef + TempChar; + {$ELSE} + msg := UTF8Decode(sCircularEntRef) + TempChar; + {$ENDIF} + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg); end; on E:EVpParserError do raise; @@ -1882,9 +1868,12 @@ begin except on E:EStringListError do begin EntRefs.Free; - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sCircularEntRef + TempChar); + {$IFDEF DELPHI} + msg := sCircularEntRef + TempChar; + {$ELSE} + msg := UTF8Decode(sCircularEntRef) + TempChar; + {$ENDIF} + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg); end; on E:EVpParserError do raise; @@ -1897,9 +1886,7 @@ begin CurrCharRef := False; end; if TempChar <> cDelim then - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - 'Expected: ' + cDelim); + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, 'Expected: ' + cDelim); SkipChar; @@ -1911,7 +1898,7 @@ begin EntRefs.Free; end; {--------} -function TVpParser.ReadNameToken(aValFirst : Boolean) : DOMString; +function TVpParser.ReadNameToken(aValFirst: Boolean): DOMString; var TempChar : DOMChar; First : Boolean; @@ -2074,18 +2061,24 @@ begin SetEntity(sName, ENTITY_INTERNAL, '', '', sValue, '', aIsPE); end; {--------} -procedure TVpParser.SetNotation(const sNotationName, - sPublicId, - sSystemId : DOMString); +procedure TVpParser.SetNotation(const sNotationName, sPublicId, sSystemId: DOMString); var oNot : TVpNotationInfo; wIdx : Integer; begin + {$IFDEF DELPHI} if not FNotationInfo.Find(sNotationName, wIdx) then begin + {$ELSE} + if not FNotationInfo.Find(UTF8Encode(sNotationName), wIdx) then begin + {$ENDIF} oNot := TVpNotationInfo.Create; oNot.PublicId := sPublicId; oNot.SystemId := sSystemId; + {$IFDEF DELPHI} FNotationInfo.AddObject(sNotationName, oNot); + {$ELSE} + FNotationInfo.AddObject(UTF8Encode(sNotationName), oNot); + {$ENDIF} end; end; {--------} @@ -2184,21 +2177,22 @@ begin end; end; {--------} -procedure TVpParser.ValidateEntityValue(const aValue : DOMString; - aQuoteCh : DOMChar); +procedure TVpParser.ValidateEntityValue(const aValue: DOMString; aQuoteCh: DOMChar); var - TempChr : DOMChar; - i : Integer; + TempChr: DOMChar; + i: Integer; + msg: String; begin for i := 1 to Length(aValue) do begin TempChr := aValue[i]; - if (TempChr = '%') or - (TempChr = '&') or - (TempChr = aQuoteCh) then - raise EVpParserError.CreateError (FFilter.Line, - FFilter.LinePos, - sInvEntityValue + - QuotedStr(TempChr)); + if (TempChr = '%') or (TempChr = '&') or (TempChr = aQuoteCh) then begin + {$IFDEF DELPHI} + msg := sInvEntityValue + QuotedStr(TempChr)); + {$ELSE} + msg := sInvEntityValue + QuotedStr(UTF8Encode(TempChr)); + {$ENDIF} + raise EVpParserError.CreateError(FFilter.Line, FFilter.LinePos, msg); + end; end; end; {--------}