From 2c7564c3148c3f701b5cc430326c3bbda92399e4 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 18 Mar 2018 17:49:53 +0000 Subject: [PATCH] jvcllaz: Add TJvMarkupViewer and TJvMarkupLabel. Add designtime package for JvCmp (JvSpellChecker). git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6254 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../jvcllaz/design/JvCmp/images/images.txt | 2 + .../jvcllaz/design/JvCmp/images/make_res.bat | 1 + .../design/JvCmp/images/tjvspellchecker.bmp | Bin 0 -> 1654 bytes components/jvcllaz/design/JvCmp/jvcmpreg.pas | 31 + .../jvcllaz/design/JvJans/images/images.txt | 7 +- .../jvcllaz/design/JvJans/jvjansreg.pas | 7 + components/jvcllaz/packages/jvcllaz_all.lpg | 7 +- components/jvcllaz/packages/jvcmpd.lpk | 49 ++ components/jvcllaz/packages/jvjanslazd.lpk | 1 - components/jvcllaz/packages/jvjanslazr.lpk | 14 +- components/jvcllaz/resource/jvcmpreg.res | Bin 0 -> 3428 bytes components/jvcllaz/resource/jvjansreg.res | Bin 27160 -> 22076 bytes components/jvcllaz/run/JvCtrls/JvHint.pas | 2 - .../jvcllaz/run/JvDB/JvDBSearchEdit.pas | 2 +- components/jvcllaz/run/JvDB/JvDBTreeView.pas | 2 +- .../jvcllaz/run/JvJans/JvMarkupCommon.pas | 236 +++++++ .../jvcllaz/run/JvJans/JvMarkupLabel.pas | 644 ++++++++++++++++++ .../jvcllaz/run/JvJans/JvMarkupViewer.pas | 618 +++++++++++++++++ 18 files changed, 1609 insertions(+), 14 deletions(-) create mode 100644 components/jvcllaz/design/JvCmp/images/images.txt create mode 100644 components/jvcllaz/design/JvCmp/images/make_res.bat create mode 100644 components/jvcllaz/design/JvCmp/images/tjvspellchecker.bmp create mode 100644 components/jvcllaz/design/JvCmp/jvcmpreg.pas create mode 100644 components/jvcllaz/packages/jvcmpd.lpk create mode 100644 components/jvcllaz/resource/jvcmpreg.res create mode 100644 components/jvcllaz/run/JvJans/JvMarkupCommon.pas create mode 100644 components/jvcllaz/run/JvJans/JvMarkupLabel.pas create mode 100644 components/jvcllaz/run/JvJans/JvMarkupViewer.pas diff --git a/components/jvcllaz/design/JvCmp/images/images.txt b/components/jvcllaz/design/JvCmp/images/images.txt new file mode 100644 index 000000000..dcc75cbdb --- /dev/null +++ b/components/jvcllaz/design/JvCmp/images/images.txt @@ -0,0 +1,2 @@ +tjvspellchecker.bmp +tjventerastab.bmp diff --git a/components/jvcllaz/design/JvCmp/images/make_res.bat b/components/jvcllaz/design/JvCmp/images/make_res.bat new file mode 100644 index 000000000..37d18abac --- /dev/null +++ b/components/jvcllaz/design/JvCmp/images/make_res.bat @@ -0,0 +1 @@ +lazres ../../../resource/jvcmpreg.res @images.txt diff --git a/components/jvcllaz/design/JvCmp/images/tjvspellchecker.bmp b/components/jvcllaz/design/JvCmp/images/tjvspellchecker.bmp new file mode 100644 index 0000000000000000000000000000000000000000..35be8dc6e4234f35cc32bedda9850ab1004c3bf6 GIT binary patch literal 1654 zcmZ|NF^(HC3_wwCU@UTklq_?Cxbm7vpF8jrsd*F@LC(Q0K+ceYN7&xLI$x5#8QX|v z-f&E6Bx^=rzkPp}*}m*VK6Cf!;z>TvynUEqU7iTTY$3ua5i4-zR;o(sPs!`=pCW2- zP|!r7MNFXJ#vFk}p+#JvFz~|zi9%oIRieQWNEBLxTSJUr9^`xkSO%rLeWYzI0A`6OR@eE zg~1U>jHB1qQY9K3fkdI#wlgIf9Dzik*Oqi88XSQ{q1Sc|B^n%oM4{JKP9+)~fkdI# zHZLU_9D$VA(^-DdFBnhcJWn~F#~nCEip#H;O*UPhku~_Mx!S9HZOnKOQ;muJ7u$|0u0DwI7A+ R_#=HO>?z#0@x=Z=g}=nv*{uKo literal 0 HcmV?d00001 diff --git a/components/jvcllaz/design/JvCmp/jvcmpreg.pas b/components/jvcllaz/design/JvCmp/jvcmpreg.pas new file mode 100644 index 000000000..d7c3dbc20 --- /dev/null +++ b/components/jvcllaz/design/JvCmp/jvcmpreg.pas @@ -0,0 +1,31 @@ +unit JvCmpReg; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils; + +procedure Register; + +implementation + +{$R ../../resource/jvcmpreg.res} + +uses + Classes, PropEdits, + JvDsgnConsts, +// JvEnterTab, + JvSpellChecker; + +procedure Register; +begin + RegisterComponents(RsPaletteJvcl, [ +// TJvEnterAsTab, + TJvSpellChecker + ]); +end; + +end. + diff --git a/components/jvcllaz/design/JvJans/images/images.txt b/components/jvcllaz/design/JvJans/images/images.txt index db5aacf42..f0bf3116e 100644 --- a/components/jvcllaz/design/JvJans/images/images.txt +++ b/components/jvcllaz/design/JvJans/images/images.txt @@ -9,8 +9,5 @@ tjvsimbutton.bmp tjvsimreverse.bmp tjvsimlight.bmp tjvlogic.bmp -tjvcsvbase.bmp -tjvcsvcheckbox.bmp -tjvcsvcombobox.bmp -tjvcsvedit.bmp -tjvcsvnavigator.bmp +tjvmarkupviewer.bmp +tjvmarkuplabel.bmp diff --git a/components/jvcllaz/design/JvJans/jvjansreg.pas b/components/jvcllaz/design/JvJans/jvjansreg.pas index 9a19ed62c..bdbff5fd9 100644 --- a/components/jvcllaz/design/JvJans/jvjansreg.pas +++ b/components/jvcllaz/design/JvJans/jvjansreg.pas @@ -17,6 +17,7 @@ uses Classes, JvDsgnConsts, JvYearGrid, //JvCSVData, JvCSVBaseControls, //JvCsvBaseEditor, + JvMarkupViewer, JvMarkupLabel, JvSimScope, JvSimIndicator, JvSimPID, JvSimPIDLinker, JvSimLogic; procedure Register; @@ -30,6 +31,12 @@ begin TJvSimScope, TJvSimIndicator, TJvSimPID, TJvSimPIDLinker, TJvSimConnector, TJvLogic, TJvSimButton, TJvSimLight, TJvSimLogicBox, TJvSimReverse]); + + // Markup components + RegisterComponents(RsPaletteJvcl, [ + TJvMarkupViewer, TJvMarkupLabel + ]); + (* // CSV Components RegisterComponents('Data Access', [TJvCSVDataset]); diff --git a/components/jvcllaz/packages/jvcllaz_all.lpg b/components/jvcllaz/packages/jvcllaz_all.lpg index 0a893a56a..70dcd3d14 100644 --- a/components/jvcllaz/packages/jvcllaz_all.lpg +++ b/components/jvcllaz/packages/jvcllaz_all.lpg @@ -1,7 +1,7 @@ - + @@ -21,8 +21,9 @@ - - + + + diff --git a/components/jvcllaz/packages/jvcmpd.lpk b/components/jvcllaz/packages/jvcmpd.lpk new file mode 100644 index 000000000..8d2929acb --- /dev/null +++ b/components/jvcllaz/packages/jvcmpd.lpk @@ -0,0 +1,49 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/components/jvcllaz/packages/jvjanslazd.lpk b/components/jvcllaz/packages/jvjanslazd.lpk index 6a26ddbb8..b2d578605 100644 --- a/components/jvcllaz/packages/jvjanslazd.lpk +++ b/components/jvcllaz/packages/jvjanslazd.lpk @@ -9,7 +9,6 @@ - diff --git a/components/jvcllaz/packages/jvjanslazr.lpk b/components/jvcllaz/packages/jvjanslazr.lpk index 42edee6d5..d862acfab 100644 --- a/components/jvcllaz/packages/jvjanslazr.lpk +++ b/components/jvcllaz/packages/jvjanslazr.lpk @@ -17,7 +17,7 @@ - Simulation components"/> - + @@ -46,6 +46,18 @@ + + + + + + + + + + + + diff --git a/components/jvcllaz/resource/jvcmpreg.res b/components/jvcllaz/resource/jvcmpreg.res new file mode 100644 index 0000000000000000000000000000000000000000..a8ae841d774565fb82e225220d68c26397dab40f GIT binary patch literal 3428 zcmeIzv5q4}5P;#bZ+B%AT}ap=Z?FXHx!`mX0))_UBJPmKs7L7l@f?*Q@eBm@2$!#P z=CAH)?~E4`LbN^pT)kC2-817}TSTPbd>-g-+OKyaUy(VV_wqr$lV9X#`AOc%4;*jh zTY7Khd*0tKXT5&?bov)`KVR(R&_ak>di!WiP;Fe(-n6Y|I6j$pTBdViV6y) z!4V=VD4?Sih6YE7R6&7)KdPa@5zD%TsHiYBI6{Q3v;swip}`Scq@X}iVQ6rK2rr2O zMTMck5u(CnNCQDJCs z#CVjg5ET`M21ks??1iYPFf=%#e*_wZsHiYBI6{p3Hz~+FugIgp5n@G9pr|l3IAVNk zT8N4YLxUs6M_LO}QDJCs#Q3;b#7t3PXmG^X3at8kBgCoXvwL(->7#bWg zwsI>(MTMck5o4QsAu1{iO+G%J%zQF=Aqr3=klMHHqtjwg&e^B_0cz1 zc?vlR*=L23&iBg_eW|`^pX^yav$X9ABloYe<^uT}mkea-LH2j0J-p6x&V zKIKM@fcHJyzq>so|2L_KAzR<(qxujUHz*VXGmNpHyOOTLw1PMhvI%@vnK7xjVPoRLF&){P?vC1)HZ*ILH zdYt5>o3Y2<_2lVe_Wm+^{XE@26p?Y5f~m%z}deN5P=rHKMG9$H?EB}pYx6y*0Z$71^9tDB|D^?Z~*r0Z6Yn=LoX~~ z{vh)SobVtx!Q2y;PbJ`qjn~Q?;IwwOY zt@*l_$q>5CNS(5;VhFQ^!#9SgL~96#Q;eH5ZGCzn?2*$G%l&-{Xk;O* z)zc(kq1MxQg9tx|45$8zyG!uVI=;C&psoWy^Tufd2a9|WOZe1ZBl=!aWydPw01JV* zXo4>df&bEo;r-^uaJ2b+_}$*Rt?k~WeKdQQ-kknz4;!x?o2!++2PEj+Vm?1V2Q|XE z!*ihc^qGKvB+7Uu496nu-y6Yrgul;3VuZj31y`cNLCJZANDG-FGQl`1D1R<0%)2X& zGk^o`GczF!?_~q25-U6utNH`nxxh{%j}SV50j&k@LOP+;%=|rmG$B_7)F_}LEI|DW zG4apD)Zd7bf55)|6Fz6jNR`Nh7!!5CaMIq(GCHDnm>oxu(Lv);B{k_BIwWh#akO?5 zDIskc3Qd-b1^_qzB(aoT@z2VT>~t01V4+NKNWj1mt8oxx93knXz}1qH7O4a|QLtE# zW(C*v$7$tro%5agMscN(!kwoD+r1rHrR08R;SisFGx3shBjYiWtrwnUwbECB4QgiN0<>ZnxHn zw$@KS-C0kwsT|j&75LnhnY4nug=&A5kl<2CzTiESrWfP*Dj&X?QVhp?fZfLgL)XF~ zt&~vlPujAClBSU{XYOXnAJ4o;{Je^|3dfLxOJy<#qvPSX%(~&h=7#TFX*Aj?osJ`WSTu{Sp`~c^z{W4-zz!aCcqzUDX^DAzgsQeHD z&!yaSBpRca{=17rg^x?5-$nzUYivR&>W~!*p4GvrM8kbOXE?$L9b`IZ>VRwen>42h cnVwV_J9^`*4ZmtGajK#zK3(zDCmUG*0SZ1E#Q*>R diff --git a/components/jvcllaz/run/JvCtrls/JvHint.pas b/components/jvcllaz/run/JvCtrls/JvHint.pas index fea7a0636..978d7d9b9 100644 --- a/components/jvcllaz/run/JvCtrls/JvHint.pas +++ b/components/jvcllaz/run/JvCtrls/JvHint.pas @@ -30,8 +30,6 @@ unit JvHint; {$mode objfpc}{$H+} -//{.$I jvcl.inc} - interface uses diff --git a/components/jvcllaz/run/JvDB/JvDBSearchEdit.pas b/components/jvcllaz/run/JvDB/JvDBSearchEdit.pas index ed0be0f6e..0b4c9e92f 100644 --- a/components/jvcllaz/run/JvDB/JvDBSearchEdit.pas +++ b/components/jvcllaz/run/JvDB/JvDBSearchEdit.pas @@ -11,7 +11,7 @@ the specific language governing rights and limitations under the License. The Original Code is: JvDBSearchEdit.pas, released on 2004-02-28. The Initial Developer of the Original Code is Lionel Reynaud -Portions created by Sébastien Buysse are Copyright (C) 2004 Lionel Reynaud. +Portions created by Sébastien Buysse are Copyright (C) 2004 Lionel Reynaud. All Rights Reserved. Contributor(s): diff --git a/components/jvcllaz/run/JvDB/JvDBTreeView.pas b/components/jvcllaz/run/JvDB/JvDBTreeView.pas index a7c4fc59f..8d3460f10 100644 --- a/components/jvcllaz/run/JvDB/JvDBTreeView.pas +++ b/components/jvcllaz/run/JvDB/JvDBTreeView.pas @@ -1,4 +1,4 @@ -{----------------------------------------------------------------------------- +{----------------------------------------------------------------------------- The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at diff --git a/components/jvcllaz/run/JvJans/JvMarkupCommon.pas b/components/jvcllaz/run/JvJans/JvMarkupCommon.pas new file mode 100644 index 000000000..0eb9d2537 --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvMarkupCommon.pas @@ -0,0 +1,236 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvMarkupCommon.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): Robert Love [rlove att slcdug dott org]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: + * Classes extracted from JvMarkupLabel and JvMarkupViewer (duplicates) + +-----------------------------------------------------------------------------} +// $Id$ + +unit JvMarkupCommon; + +{$mode objfpc}{$H+} + +interface + +uses + Controls, Graphics, SysUtils, Classes; + +type + TJvHTMLElement = class(TObject) + private + FFontSize: Integer; + FText: string; + FFontName: string; + FFontStyle: TFontStyles; + FFontColor: TColor; + FAscent: Integer; + FHeight: Integer; + FWidth: Integer; + FSolText: string; + FEolText: string; + FBreakLine: Boolean; + procedure SetFontName(const Value: string); + procedure SetFontSize(const Value: Integer); + procedure SetFontStyle(const Value: TFontStyles); + procedure SetText(const Value: string); + procedure SetFontColor(const Value: TColor); + procedure SetAscent(const Value: Integer); + procedure SetHeight(const Value: Integer); + procedure SetWidth(const Value: Integer); + procedure SetEolText(const Value: string); + procedure SetSolText(const Value: string); + procedure SetBreakLine(const Value: Boolean); + public + procedure Breakup(ACanvas: TCanvas; Available: Integer); + property Text: string read FText write SetText; + property SolText: string read FSolText write SetSolText; + property EolText: string read FEolText write SetEolText; + property FontName: string read FFontName write SetFontName; + property FontSize: Integer read FFontSize write SetFontSize; + property FontStyle: TFontStyles read FFontStyle write SetFontStyle; + property FontColor: TColor read FFontColor write SetFontColor; + property Height: Integer read FHeight write SetHeight; + property Width: Integer read FWidth write SetWidth; + property Ascent: Integer read FAscent write SetAscent; + property BreakLine: Boolean read FBreakLine write SetBreakLine; + end; + + TJvHTMLElementStack = class(TList) + public + destructor Destroy; override; + procedure Clear; override; + // will free ALL elements in the stack + procedure Push(Element: TJvHTMLElement); + function Pop: TJvHTMLElement; + // calling routine is responsible for freeing the element. + function Peek: TJvHTMLElement; + // calling routine must NOT free the element + end; + + +{$IFDEF UNITVERSIONING} +const + UnitVersioning: TUnitVersionInfo = ( + RCSfile: '$URL$'; + Revision: '$Revision$'; + Date: '$Date$'; + LogPath: 'JVCL\run' + ); +{$ENDIF UNITVERSIONING} + +implementation + + +//=== { TJvHTMLElement } ===================================================== + +procedure TJvHTMLElement.Breakup(ACanvas: TCanvas; Available: Integer); +var + S: string; + I, W: Integer; +begin + ACanvas.Font.Name := FontName; + ACanvas.Font.Size := FontSize; + ACanvas.Font.Style := FontStyle; + ACanvas.Font.Color := FontColor; + if SolText = '' then + S := Text + else + S := EolText; + if ACanvas.TextWidth(S) <= Available then + begin + SolText := S; + EolText := ''; + Exit; + end; + for I := Length(S) downto 1 do + begin + if S[I] = ' ' then + begin + W := ACanvas.TextWidth(Copy(S, 1, I)); + if W <= Available then + begin + SolText := Copy(S, 1, I); + EolText := Copy(S, I + 1, Length(S)); + Break; + end; + end; + end; +end; + +procedure TJvHTMLElement.SetAscent(const Value: Integer); +begin + FAscent := Value; +end; + +procedure TJvHTMLElement.SetBreakLine(const Value: Boolean); +begin + FBreakLine := Value; +end; + +procedure TJvHTMLElement.SetEolText(const Value: string); +begin + FEolText := Value; +end; + +procedure TJvHTMLElement.SetFontColor(const Value: TColor); +begin + FFontColor := Value; +end; + +procedure TJvHTMLElement.SetFontName(const Value: string); +begin + FFontName := Value; +end; + +procedure TJvHTMLElement.SetFontSize(const Value: Integer); +begin + FFontSize := Value; +end; + +procedure TJvHTMLElement.SetFontStyle(const Value: TFontStyles); +begin + FFontStyle := Value; +end; + +procedure TJvHTMLElement.SetHeight(const Value: Integer); +begin + FHeight := Value; +end; + +procedure TJvHTMLElement.SetSolText(const Value: string); +begin + FSolText := Value; +end; + +procedure TJvHTMLElement.SetText(const Value: string); +begin + FText := Value; +end; + +procedure TJvHTMLElement.SetWidth(const Value: Integer); +begin + FWidth := Value; +end; + +//=== { TJvHTMLElementStack } ================================================ + +destructor TJvHTMLElementStack.Destroy; +begin + Clear; + inherited Destroy; +end; + +procedure TJvHTMLElementStack.Clear; +var + I: Integer; +begin + for I := Count - 1 downto 0 do + TJvHTMLElement(Items[I]).Free; + inherited Clear; +end; + +function TJvHTMLElementStack.Peek: TJvHTMLElement; +begin + if Count = 0 then + Result := nil + else + Result := TJvHTMLElement(Items[Count - 1]); +end; + +function TJvHTMLElementStack.Pop: TJvHTMLElement; +begin + if Count = 0 then + Result := nil + else + begin + Result := TJvHTMLElement(Items[Count - 1]); + Delete(Count - 1); + end; +end; + +procedure TJvHTMLElementStack.Push(Element: TJvHTMLElement); +begin + Add(Element); +end; + + +end. diff --git a/components/jvcllaz/run/JvJans/JvMarkupLabel.pas b/components/jvcllaz/run/JvJans/JvMarkupLabel.pas new file mode 100644 index 000000000..d3777a020 --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvMarkupLabel.pas @@ -0,0 +1,644 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvMarkupLabel.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): +Robert Love [rlove att slcdug dott org]. +Lionel Reynaud + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvMarkupLabel; + +{$mode objfpc}{$H+} + +interface + +uses + //Messages, + Graphics, Controls, + SysUtils, Classes, + JvMarkupCommon; + +type + TJvMarkupLabel = class(TGraphicControl) //TJvPubGraphicControl) + private + FElementStack: TJvHTMLElementStack; + FTagStack: TJvHTMLElementStack; + FMarginLeft: Integer; + FMarginRight: Integer; + FMarginTop: Integer; + FAlignment: TAlignment; + FText: TCaption; + procedure Refresh; + procedure ParseHTML(S: string); + procedure RenderHTML; + procedure HTMLClearBreaks; + procedure HTMLElementDimensions; + procedure SetMarginLeft(const Value: Integer); + procedure SetMarginRight(const Value: Integer); + procedure SetMarginTop(const Value: Integer); + procedure SetAlignment(const Value: TAlignment); +// procedure DoReadBackColor(Reader: TReader); + protected +// procedure FontChanged; override; + procedure SetText(const Value: TCaption); + procedure SetAutoSize(Value: Boolean); override; +// procedure DefineProperties(Filer: TFiler); override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + published + property Height default 100; + property Width default 200; + property MarginLeft: Integer read FMarginLeft write SetMarginLeft default 5; + property MarginRight: Integer read FMarginRight write SetMarginRight default 5; + property MarginTop: Integer read FMarginTop write SetMarginTop default 5; + property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify; + property Text: TCaption read FText write SetText; + property AutoSize; + property Align; + property Font; + property Anchors; + property BorderSpacing; + property Constraints; + property Enabled; + property Color default clBtnFace; // Duplicates BackColor + property ParentColor default True; + property ParentFont; + property ParentShowHint; + property PopupMenu; + property ShowHint; + property Visible; + property OnClick; + property OnContextPopup; + property OnDblClick; + property OnDragDrop; + property OnDragOver; + property OnEndDrag; + property OnMouseDown; + property OnMouseMove; + property OnMouseUp; + property OnMouseEnter; + property OnMouseLeave; + property OnStartDrag; + end; + + +implementation + +uses + Themes, + JvJCLUtils, JvConsts; + +constructor TJvMarkupLabel.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + //IncludeThemeStyle(Self, [csParentBackground]); + FElementStack := TJvHTMLElementStack.Create; + FTagStack := TJvHTMLElementStack.Create; + FAlignment := taLeftJustify; + Width := 200; + Height := 100; + FMarginLeft := 5; + FMarginRight := 5; + FMarginTop := 5; + Color := clBtnFace; + ParentColor := True; +end; + +destructor TJvMarkupLabel.Destroy; +begin + FElementStack.Free; + FTagStack.Free; + inherited Destroy; +end; + +procedure TJvMarkupLabel.HTMLClearBreaks; +var + I, C: Integer; + El: TJvHTMLElement; +begin + C := FElementStack.Count; + if C = 0 then + Exit; + for I := 0 to C - 1 do + begin + El := TJvHTMLElement(FElementStack.Items[I]); + El.SolText := ''; + El.EolText := ''; + end; +end; + +procedure TJvMarkupLabel.HTMLElementDimensions; +var + I, C: Integer; + El: TJvHTMLElement; + H, A, W: Integer; + tm: TLCLTextMetric; + //m: TTextMetric; + S: string; +begin + C := FElementStack.Count; + if C = 0 then + Exit; + for I := 0 to C - 1 do + begin + El := TJvHTMLElement(FElementStack.Items[I]); + S := El.Text; + Canvas.Font.Name := El.FontName; + Canvas.Font.Size := El.FontSize; + Canvas.Font.Style := El.FontStyle; + Canvas.Font.Color := El.FontColor; + Canvas.GetTextMetrics(tm); +// GetTextMetrics(Canvas.Handle, Tm); + H := tm.Height; + A := tm.Ascender; + W := Canvas.TextWidth(S); + El.Height := H; + El.Ascent := A; + El.Width := W; + end; +end; + +procedure TJvMarkupLabel.Refresh; +begin + ParseHTML(FText); + HTMLElementDimensions; + Invalidate; +end; + +procedure TJvMarkupLabel.Paint; +begin + RenderHTML; +end; + +{ +procedure TJvMarkupLabel.FontChanged; +begin + inherited FontChanged; + Refresh; +end; +} + +procedure TJvMarkupLabel.ParseHTML(S: string); +var + P: Integer; + SE, ST: string; + lText: string; + lStyle: TFontStyles; + lName: string; + lSize: Integer; + lBreakLine: Boolean; + AColor, lColor: TColor; + Element: TJvHTMLElement; + + function HTMLStringToColor(V: string; var Col: TColor): Boolean; + var + VV: string; + begin + Result := False; + if Length(V) < 2 then + Exit; + if not CharInSet(V[1], ['#', '$']) then + begin + // allow the use of both "clBlack" and "Black" + if Pos('cl', AnsiLowerCase(V)) = 1 then + VV := V + else + VV := 'cl' + V; + try + Col := StringToColor(VV); + Result := True; + except + Result := False; + end; + end + else + // this is either #FFFFFF or $FFFFFF - we treat them the same + begin + try + VV := '$' + Copy(V, 6, 2) + Copy(V, 4, 2) + Copy(V, 2, 2); + Col := StringToColor(VV); + Result := True; + except + Result := False; + end + end; + end; + + procedure PushTag; + begin + Element := TJvHTMLElement.Create; + Element.FontName := lName; + Element.FontSize := lSize; + Element.FontStyle := lStyle; + Element.FontColor := lColor; + FTagStack.Push(Element); + end; + + procedure PopTag; + begin + Element := FTagStack.Pop; + if Element <> nil then + begin + lName := Element.FontName; + lSize := Element.FontSize; + lStyle := Element.FontStyle; + lColor := Element.FontColor; + Element.Free; + end; + end; + + procedure PushElement; + begin + Element := TJvHTMLElement.Create; + Element.Text := lText; + Element.FontName := lName; + Element.FontSize := lSize; + Element.FontStyle := lStyle; + Element.FontColor := lColor; + Element.BreakLine := lBreakLine; + lBreakLine := False; + FElementStack.Push(Element); + end; + + procedure ParseTag(SS: string); + var + PP: Integer; + ATag, APar, AVal: string; + HaveParams: Boolean; + begin + SS := Trim(SS); + HaveParams := False; + PP := Pos(' ', SS); + if PP = 0 then + ATag := SS // tag only + else + begin // tag + attributes + ATag := Copy(SS, 1, PP - 1); + SS := Trim(Copy(SS, PP + 1, Length(SS))); + HaveParams := True; + end; + // handle ATag + ATag := LowerCase(ATag); + if ATag = 'br' then + lBreakLine := True + else + if ATag = 'b' then + begin // bold + PushTag; + lStyle := lStyle + [fsBold]; + end + else + if ATag = '/b' then + begin // cancel bold + lStyle := lStyle - [fsBold]; + PopTag; + end + else + if ATag = 'i' then + begin // italic + PushTag; + lStyle := lStyle + [fsItalic]; + end + else + if ATag = '/i' then + begin // cancel italic + lStyle := lStyle - [fsItalic]; + PopTag; + end + else + if ATag = 'u' then + begin // underline + PushTag; + lStyle := lStyle + [fsUnderline]; + end + else + if ATag = '/u' then + begin // cancel underline + lStyle := lStyle - [fsUnderline]; + PopTag; + end + else + if ATag = 'font' then + PushTag + else + if ATag = '/font' then + PopTag; + if HaveParams then + begin + repeat + PP := Pos('="', SS); + if PP > 0 then + begin + APar := LowerCase(Trim(Copy(SS, 1, PP - 1))); + Delete(SS, 1, PP + 1); + PP := Pos('"', SS); + if PP > 0 then + begin + AVal := Copy(SS, 1, PP - 1); + Delete(SS, 1, PP); + if APar = 'face' then + lName := AVal + else + if APar = 'size' then + try + lSize := StrToInt(AVal); + except + end + else + if APar = 'color' then + try + if HTMLStringToColor(AVal, AColor) then + lColor := AColor; + except + end; + end; + end; + until PP = 0; + end; + end; + +begin + FElementStack.Clear; + FTagStack.Clear; + lStyle := Font.Style; + lName := Font.Name; + lSize := Font.Size; + lColor := Font.Color; + lBreakLine := False; + repeat + P := Pos('<', S); + if P = 0 then + begin + lText := S; + PushElement; + end + else + begin + if P > 1 then + begin + SE := Copy(S, 1, P - 1); + lText := SE; + PushElement; + Delete(S, 1, P - 1); + end; + P := Pos('>', S); + if P > 0 then + begin + ST := Copy(S, 2, P - 2); + Delete(S, 1, P); + ParseTag(ST); + end; + end; + until P = 0; +end; + +procedure TJvMarkupLabel.RenderHTML; +var + R: TRect; + I, C, X, Y: Integer; + ATotalWidth, AClientWidth, ATextWidth, BaseLine: Integer; + iSol, iEol, PendingCount, MaxHeight, MaxAscent: Integer; + El: TJvHTMLElement; + Eol: Boolean; + PendingBreak: Boolean; + lSolText: string; + MaxWidth: Integer; + + procedure SetFont(EE: TJvHTMLElement); + begin + with Canvas do + begin + Font.Name := EE.FontName; + Font.Size := EE.FontSize; + Font.Style := EE.FontStyle; + Font.Color := EE.FontColor; + end; + end; + + procedure RenderString(EE: TJvHTMLElement; Test: Boolean); + var + SS: string; + WW: Integer; + begin + SetFont(EE); + if EE.SolText <> '' then + begin + SS := TrimLeft(EE.SolText); + WW := Canvas.TextWidth(SS); + if not Test then + Canvas.TextOut(X, Y + BaseLine - EE.Ascent, SS); + X := X + WW; + end; + end; + +begin + iEol := 0; // Not Needed but removes warning. + R := ClientRect; + Canvas.Brush.Color := Color; + Canvas.FillRect(R); + //DrawThemedBackground(Self, Canvas, R); + C := FElementStack.Count; + if C = 0 then + Exit; + HTMLClearBreaks; + if AutoSize then + AClientWidth := 10000 + else + AClientWidth := ClientWidth - MarginLeft - MarginRight; + + Canvas.Brush.Style := bsClear; + Y := MarginTop; + iSol := 0; + PendingBreak := False; + PendingCount := -1; + MaxWidth := 0; + repeat + I := iSol; + ATotalWidth := AClientWidth; + ATextWidth := 0; + MaxHeight := 0; + MaxAscent := 0; + Eol := False; + repeat // scan line + El := TJvHTMLElement(FElementStack.Items[I]); + if El.BreakLine then + begin + if not PendingBreak and (PendingCount <> I) then + begin + PendingBreak := True; + PendingCount := I; + iEol := I; + Break; + end + else + PendingBreak := False; + end; + if El.Height > MaxHeight then + MaxHeight := El.Height; + if El.Ascent > MaxAscent then + MaxAscent := El.Ascent; + if El.Text <> '' then + begin + lSolText := El.SolText; + // (Lionel) If Breakup can do something, I increase a bit the space until + // it can do the break ... + repeat + El.Breakup(Canvas, ATotalWidth); + Inc(ATotalWidth, 5); + until lSolText <> El.SolText; + end; + if El.SolText <> '' then + begin + ATotalWidth := ATotalWidth - Canvas.TextWidth(El.SolText) - 5; + ATextWidth := ATextWidth + Canvas.TextWidth(El.SolText); + if El.EolText = '' then + begin + if I >= C - 1 then + begin + Eol := True; + iEol := I; + end + else + Inc(I); + end + else + begin + Eol := True; + iEol := I; + end; + end + else + begin // Eol + Eol := True; + iEol := I; + end; + until Eol; + + // render line + BaseLine := MaxAscent; + + if AutoSize then + begin + X := MarginLeft; + if (ATextWidth + MarginLeft + MarginRight) > MaxWidth then + MaxWidth := (ATextWidth + MarginLeft + MarginRight); + end + else + case Alignment of + taLeftJustify: + X := MarginLeft; + taRightJustify: + X := Width - MarginRight - ATextWidth; + taCenter: + X := MarginLeft + (Width - MarginLeft - MarginRight - ATextWidth) div 2; + end; + + for I := iSol to iEol do + begin + El := TJvHTMLElement(FElementStack.Items[I]); + RenderString(El, False); + end; + + Y := Y + MaxHeight; + iSol := iEol; + until (iEol >= C - 1) and (El.EolText = ''); + if AutoSize then + begin + Width := MaxWidth; + Height := Y + 5; + end; +end; + +procedure TJvMarkupLabel.SetAlignment(const Value: TAlignment); +begin + if Value <> FAlignment then + begin + FAlignment := Value; + Invalidate; + end; +end; + +procedure TJvMarkupLabel.SetAutoSize(Value: Boolean); +begin + inherited SetAutoSize(Value); + Invalidate; +end; + +procedure TJvMarkupLabel.SetMarginLeft(const Value: Integer); +begin + FMarginLeft := Value; + Invalidate; +end; + +procedure TJvMarkupLabel.SetMarginRight(const Value: Integer); +begin + FMarginRight := Value; + Invalidate; +end; + +procedure TJvMarkupLabel.SetMarginTop(const Value: Integer); +begin + FMarginTop := Value; + Invalidate; +end; + +procedure TJvMarkupLabel.SetText(const Value: TCaption); +var + S: string; +begin + if Value = FText then + Exit; + S := Value; + S := StringReplace(S, SLineBreak, ' ', [rfReplaceAll]); + S := TrimRight(S); + FText := S; + Refresh; +end; + +{function TJvMarkupLabel.GetBackColor: TColor; +begin + Result := Color; +end; + +procedure TJvMarkupLabel.SetBackColor(const Value: TColor); +begin + Color := Value; +end;} + { +procedure TJvMarkupLabel.DoReadBackColor(Reader: TReader); +begin + if Reader.NextValue = vaIdent then + Color := StringToColor(Reader.ReadIdent) + else + Color := Reader.ReadInteger; +end; + +procedure TJvMarkupLabel.DefineProperties(Filer: TFiler); +begin + inherited DefineProperties(Filer); + Filer.DefineProperty('BackColor', @DoReadBackColor, nil, False); +end; + } + +end. diff --git a/components/jvcllaz/run/JvJans/JvMarkupViewer.pas b/components/jvcllaz/run/JvJans/JvMarkupViewer.pas new file mode 100644 index 000000000..3de7a5aec --- /dev/null +++ b/components/jvcllaz/run/JvJans/JvMarkupViewer.pas @@ -0,0 +1,618 @@ +{----------------------------------------------------------------------------- +The contents of this file are subject to the Mozilla Public License +Version 1.1 (the "License"); you may not use this file except in compliance +with the License. You may obtain a copy of the License at +http://www.mozilla.org/MPL/MPL-1.1.html + +Software distributed under the License is distributed on an "AS IS" basis, +WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for +the specific language governing rights and limitations under the License. + +The Original Code is: JvMarkupViewer.PAS, released on 2002-06-15. + +The Initial Developer of the Original Code is Jan Verhoeven [jan1 dott verhoeven att wxs dott nl] +Portions created by Jan Verhoeven are Copyright (C) 2002 Jan Verhoeven. +All Rights Reserved. + +Contributor(s): Robert Love [rlove att slcdug dott org]. + +You may retrieve the latest version of this file at the Project JEDI's JVCL home page, +located at http://jvcl.delphi-jedi.org + +Known Issues: +-----------------------------------------------------------------------------} +// $Id$ + +unit JvMarkupViewer; + +{$mode objfpc}{$H+} + +interface + +uses + SysUtils, Classes, + Messages, Graphics, Forms, Controls, StdCtrls, + JvMarkupCommon; + +type + TJvMarkupViewer = class(TCustomControl) + private + FScrollBar: TScrollBar; + FBmp: TBitmap; + FrameTop: Integer; + FrameBottom: Integer; + PageBottom: Integer; + FElementStack: TJvHTMLElementStack; + FTagStack: TJvHTMLElementStack; + FBackColor: TColor; + FMarginLeft: Integer; + FMarginRight: Integer; + FMarginTop: Integer; + FText: TCaption; + function GetText: TCaption; + procedure SetText(const Value: TCaption); + procedure ParseHTML(s: string); + procedure RenderHTML; + procedure HTMLClearBreaks; + procedure HTMLElementDimensions; + procedure SetBackColor(const Value: TColor); + procedure SetMarginLeft(const Value: Integer); + procedure SetMarginRight(const Value: Integer); + procedure SetMarginTop(const Value: Integer); + procedure ScrollViewer(Sender: TObject); + protected + procedure CreateWnd; override; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Paint; override; + published + property Width default 300; + property Height default 275; + property Text: TCaption read GetText write SetText; + property BackColor: TColor read FBackColor write SetBackColor default clWhite; + property MarginLeft: Integer read FMarginLeft write SetMarginLeft default 5; + property MarginRight: Integer read FMarginRight write SetMarginRight default 5; + property MarginTop: Integer read FMarginTop write SetMarginTop default 5; + + property Align; + property BorderSpacing; + property BorderStyle; + property BorderWidth; + property Constraints; + property Font; + property ParentFont; + property PopupMenu; + property Visible; + property OnClick; + property OnMouseDown; + property OnMouseEnter; + property OnMouseLeave; + property OnMouseMove; + property OnMouseUp; + property OnMouseWheel; + property OnMouseWheelDown; + property OnMouseWheelUp; + property OnResize; + end; + +implementation + +uses + JvConsts, Themes; + +constructor TJvMarkupViewer.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + //IncludeThemeStyle(Self, [csParentBackground]); + FElementStack := TJvHTMLElementStack.Create; + FTagStack := TJvHTMLElementStack.Create; + Width := 300; + Height := 275; + FMarginLeft := 5; + FMarginRight := 5; + FMarginTop := 5; + FBackColor := clWhite; +end; + +destructor TJvMarkupViewer.Destroy; +begin + FElementStack.Free; + FTagStack.Free; + FBmp.Free; + FScrollBar.Free; + inherited Destroy; +end; + +procedure TJvMarkupViewer.HTMLClearBreaks; +var + I, C: Integer; + Element: TJvHTMLElement; +begin + C := FElementStack.Count; + if C = 0 then + Exit; + for I := 0 to C - 1 do + begin + Element := TJvHTMLElement(FElementStack.Items[I]); + Element.SolText := ''; + Element.EolText := ''; + end; +end; + +procedure TJvMarkupViewer.HTMLElementDimensions; +var + I, C: Integer; + Element: TJvHTMLElement; + h, a, w: Integer; + tm: TLCLTextMetric; +// tm: TEXTMETRIC; + s: string; +begin + C := FElementStack.Count; + if C = 0 then + Exit; + for I := 0 to C - 1 do + begin + Element := TJvHTMLElement(FElementStack.Items[I]); + s := Element.Text; + Canvas.Font.Name := Element.FontName; + Canvas.Font.Size := Element.FontSize; + Canvas.Font.Style := Element.FontStyle; + Canvas.Font.Color := Element.FontColor; + Canvas.GetTextMetrics(tm); +// GetTextMetrics(Canvas.Handle, tm); + h := tm.Height; + a := tm.Ascender; + w := Canvas.TextWidth(s); + Element.Height := h; + Element.Ascent := a; + Element.Width := w; + end; +end; + +procedure TJvMarkupViewer.CreateWnd; +begin + inherited CreateWnd; + FScrollBar := TScrollBar.Create(Self); + FScrollBar.Kind := sbVertical; + FScrollBar.Parent := Self; + FScrollBar.Align := alRight; + FScrollBar.Min := 0; + FScrollBar.Max := 0; + FScrollBar.OnChange := @ScrollViewer; + FrameTop := 0; + FrameBottom := ClientHeight; + FBmp := TBitmap.Create; + FBmp.Width := ClientWidth - FScrollBar.Width; + FBmp.Height := ClientHeight; +end; + +procedure TJvMarkupViewer.Paint; +var + sm: Integer; + w, h: Integer; +begin + w := ClientWidth - FScrollBar.Width; + h := ClientHeight; + FBmp.Width := w; + FBmp.Height := h; + RenderHTML; + Canvas.Draw(0, 0, FBmp); + FScrollBar.Min := 0; + sm := PageBottom - ClientHeight; + if sm > 0 then + FScrollBar.Max := sm + else + FScrollBar.Max := 0; + FScrollBar.Position := 0; + FScrollBar.LargeChange := Trunc(0.8 * ClientHeight); +end; + +procedure TJvMarkupViewer.ParseHTML(s: string); +var + p: Integer; + se, st: string; + LText: string; + FStyle: TFontStyles; + FName: string; + FSize: Integer; + LBreakLine: Boolean; + AColor, FColor: TColor; + Element: TJvHTMLElement; + + function HTMLStringToColor(v: string; var col: TColor): Boolean; + var + vv: string; + begin + if Copy(v, 1, 1) <> '#' then + begin + vv := 'cl' + v; + try + col := StringToColor(vv); + Result := True; + except + Result := False; + end; + end + else + begin + try + vv := '$' + Copy(v, 6, 2) + Copy(v, 4, 2) + Copy(v, 2, 2); + col := StringToColor(vv); + Result := True; + except + Result := False; + end + end + end; + + procedure PushTag; + begin + Element := TJvHTMLElement.Create; + Element.FontName := FName; + Element.FontSize := FSize; + Element.FontStyle := FStyle; + Element.FontColor := FColor; + FTagStack.Push(Element); + end; + + procedure PopTag; + begin + Element := FTagStack.Pop; + if Element <> nil then + begin + FName := Element.FontName; + FSize := Element.FontSize; + FStyle := Element.FontStyle; + FColor := Element.FontColor; + Element.Free; + end; + end; + + procedure PushElement; + begin + Element := TJvHTMLElement.Create; + Element.Text := LText; + Element.FontName := FName; + Element.FontSize := FSize; + Element.FontStyle := FStyle; + Element.FontColor := FColor; + Element.BreakLine := LBreakLine; + LBreakLine := False; + FElementStack.Push(Element); + end; + + procedure ParseTag(SS: string); + var + PP: Integer; + LTag, LPar, LVal: string; + HavePar: Boolean; + begin + SS := Trim(SS); + HavePar := False; + PP := Pos(' ', SS); + if PP = 0 then + LTag := SS // tag only + else + begin // tag + attributes + LTag := Copy(SS, 1, PP - 1); + SS := Trim(Copy(SS, PP + 1, Length(SS))); + HavePar := True; + end; + // handle LTag + LTag := LowerCase(LTag); + if LTag = 'br' then + LBreakLine := True + else + if LTag = 'b' then + begin // bold + PushTag; + FStyle := FStyle + [fsBold]; + end + else + if LTag = '/b' then + begin // cancel bold + FStyle := FStyle - [fsBold]; + PopTag; + end + else + if LTag = 'i' then + begin // italic + PushTag; + FStyle := FStyle + [fsItalic]; + end + else + if LTag = '/i' then + begin // cancel italic + FStyle := FStyle - [fsItalic]; + PopTag; + end + else + if LTag = 'u' then + begin // underline + PushTag; + FStyle := FStyle + [fsUnderline]; + end + else + if LTag = '/u' then + begin // cancel underline + FStyle := FStyle - [fsUnderline]; + PopTag; + end + else + if LTag = 'font' then + PushTag + else + if LTag = '/font' then + PopTag; + if HavePar then + begin + repeat + PP := Pos('="', SS); + if PP > 0 then + begin + LPar := LowerCase(Trim(Copy(SS, 1, PP - 1))); + Delete(SS, 1, PP + 1); + PP := Pos('"', SS); + if PP > 0 then + begin + LVal := Copy(SS, 1, PP - 1); + Delete(SS, 1, PP); + if LPar = 'face' then + FName := LVal + else + if LPar = 'size' then + try + FSize := StrToInt(LVal); + except + end + else + if LPar = 'color' then + try + if HTMLStringToColor(LVal, AColor) then + FColor := AColor; + except + end + end; + end; + until PP = 0; + end; + end; + +begin + FElementStack.Clear; + FTagStack.Clear; + FStyle := Font.Style; + FName := Font.Name; + FSize := Font.Size; + FColor := Font.Color; + LBreakLine := False; + repeat + p := Pos('<', s); + if p = 0 then + begin + LText := s; + PushElement; + end + else + begin + if p > 1 then + begin + se := Copy(s, 1, p - 1); + LText := se; + PushElement; + Delete(s, 1, p - 1); + end; + p := Pos('>', s); + if p > 0 then + begin + st := Copy(s, 2, p - 2); + Delete(s, 1, p); + ParseTag(st); + end; + end; + until p = 0; +end; + +procedure TJvMarkupViewer.RenderHTML; +var + R: TRect; + X, Y, xav, clw: Integer; + BaseLine: Integer; + I, C: Integer; + el: TJvHTMLElement; + eol: Boolean; + ml: Integer; // margin left + isol, ieol: Integer; + MaxHeight, MaxAscent: Integer; + PendingBreak: Boolean; + + procedure SetFont(AElem: TJvHTMLElement); + begin + with FBmp.Canvas do + begin + if SameText(AElem.FontName, 'default') then + Font.Name := Screen.MenuFont.Name else + Font.Name := AElem.FontName; + if AElem.FontSize = 0 then + Font.Size := 10 else + Font.Size := AElem.FontSize; + Font.Style := AElem.FontStyle; + Font.Color := AElem.FontColor; + end; + end; + + procedure RenderString(ee: TJvHTMLElement); + var + SS: string; + w: Integer; + begin + SetFont(ee); + if ee.SolText <> '' then + begin + SS := ee.SolText; + w := FBmp.Canvas.TextWidth(SS); + FBmp.Canvas.TextOut(X, Y + BaseLine - ee.Ascent - FrameTop, SS); + X := X + w; + end; + end; + +begin + ieol := 0; // Not needed but removed Warning + R := Rect(0, 0, FBmp.Width, FBmp.Height); + FBmp.Canvas.Brush.Style := bsSolid; + FBmp.Canvas.Brush.Color := FBackColor; + FBmp.Canvas.FillRect(R); + FBmp.Canvas.Font.Assign(Font); + C := FElementStack.Count; + if C = 0 then + Exit; + HTMLClearBreaks; + clw := FBmp.Width - FMarginRight; + ml := MarginLeft; + FBmp.Canvas.Brush.Style := bsClear; + Y := FMarginTop; + isol := 0; + PendingBreak := False; + repeat + I := isol; + xav := clw; + MaxHeight := 0; + MaxAscent := 0; + eol := False; + repeat // scan line + el := TJvHTMLElement(FElementStack.Items[I]); + if el.BreakLine then + begin + if not PendingBreak then + begin + eol := True; + ieol := I - 1; + // break; + end; + PendingBreak := not PendingBreak; + end; + if not PendingBreak then + begin + if el.Height > MaxHeight then + MaxHeight := el.Height; + if el.Ascent > MaxAscent then + MaxAscent := el.Ascent; + el.Breakup(FBmp.Canvas, xav); + if el.SolText <> '' then + begin + xav := xav - FBmp.Canvas.TextWidth(el.SolText); + if el.EolText = '' then + begin + if I >= C - 1 then + begin + eol := True; + ieol := I; + end + else + Inc(I); + end + else + begin + eol := True; + ieol := I; + end; + end + else + begin + eol := True; + ieol := I; + end; + end; + until eol; + + // render line, only when in visible frame + X := ml; + BaseLine := MaxAscent; + if (Y + MaxHeight >= FrameTop) and (Y <= FrameBottom) then + for I := isol to ieol do + begin + el := TJvHTMLElement(FElementStack.Items[I]); + RenderString(el); + end; + Y := Y + MaxHeight; + if not PendingBreak then + isol := ieol + else + isol := ieol + 1; + until (ieol >= C - 1) and (el.EolText = ''); + // clxfix: set transparency after bitmap has be drawn + FBmp.TransparentColor := Color; + FBmp.Transparent := True; + PageBottom := Y; +end; + +procedure TJvMarkupViewer.ScrollViewer(Sender: TObject); +begin + FrameTop := FScrollBar.Position; + FrameBottom := FrameTop + ClientHeight - 1; + RenderHTML; + Canvas.Draw(0, 0, FBmp); +end; + +procedure TJvMarkupViewer.SetBackColor(const Value: TColor); +begin + if Value <> FBackColor then + begin + FBackColor := Value; + Invalidate; + end; +end; + +procedure TJvMarkupViewer.SetMarginLeft(const Value: Integer); +begin + if Value <> FMarginLeft then + begin + FMarginLeft := Value; + Invalidate; + end; +end; + +procedure TJvMarkupViewer.SetMarginRight(const Value: Integer); +begin + if Value <> FMarginRight then + begin + FMarginRight := Value; + Invalidate; + end; +end; + +procedure TJvMarkupViewer.SetMarginTop(const Value: Integer); +begin + if Value <> FMarginTop then + begin + FMarginTop := Value; + Invalidate; + end; +end; + + +function TJvMarkupViewer.GetText: TCaption; +begin + Result := FText; +end; + + +procedure TJvMarkupViewer.SetText(const Value: TCaption); +var + S: string; +begin + if Value = FText then + Exit; + S := Value; + S := StringReplace(S, sLineBreak, ' ', [rfReplaceAll]); + S := TrimRight(S); + ParseHTML(S); + HTMLElementDimensions; + FText := S; + Invalidate; +end; + + +end.