You've already forked lazarus-ccr
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
This commit is contained in:
2
components/jvcllaz/design/JvCmp/images/images.txt
Normal file
2
components/jvcllaz/design/JvCmp/images/images.txt
Normal file
@ -0,0 +1,2 @@
|
||||
tjvspellchecker.bmp
|
||||
tjventerastab.bmp
|
1
components/jvcllaz/design/JvCmp/images/make_res.bat
Normal file
1
components/jvcllaz/design/JvCmp/images/make_res.bat
Normal file
@ -0,0 +1 @@
|
||||
lazres ../../../resource/jvcmpreg.res @images.txt
|
BIN
components/jvcllaz/design/JvCmp/images/tjvspellchecker.bmp
Normal file
BIN
components/jvcllaz/design/JvCmp/images/tjvspellchecker.bmp
Normal file
Binary file not shown.
After Width: | Height: | Size: 1.6 KiB |
31
components/jvcllaz/design/JvCmp/jvcmpreg.pas
Normal file
31
components/jvcllaz/design/JvCmp/jvcmpreg.pas
Normal file
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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]);
|
||||
|
@ -1,7 +1,7 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectGroup FileVersion="1">
|
||||
<Targets Count="21">
|
||||
<Targets Count="22">
|
||||
<Target0 FileName="JvCoreLazR.lpk"/>
|
||||
<Target1 FileName="JvCoreLazD.lpk"/>
|
||||
<Target2 FileName="JvCtrlsLazR.lpk"/>
|
||||
@ -21,8 +21,9 @@
|
||||
<Target16 FileName="jvcustomlazr.lpk"/>
|
||||
<Target17 FileName="jvcustomlazd.lpk"/>
|
||||
<Target18 FileName="jvcmpr.lpk"/>
|
||||
<Target19 FileName="jvjanslazr.lpk"/>
|
||||
<Target20 FileName="jvjanslazd.lpk"/>
|
||||
<Target19 FileName="jvcmpd.lpk"/>
|
||||
<Target20 FileName="jvjanslazr.lpk"/>
|
||||
<Target21 FileName="jvjanslazd.lpk"/>
|
||||
</Targets>
|
||||
</ProjectGroup>
|
||||
</CONFIG>
|
||||
|
49
components/jvcllaz/packages/jvcmpd.lpk
Normal file
49
components/jvcllaz/packages/jvcmpd.lpk
Normal file
@ -0,0 +1,49 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="jvcmpd"/>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<Author Value="Various authors - see header of each unit for original author."/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<OtherUnitFiles Value="..\design\JvCmp"/>
|
||||
<UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)\design\JvCmp"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Description Value="Custom controls of the JVCL library (https://sourceforge.net/projects/jvcl/) (runtime code):
|
||||
- Spellchecker component
|
||||
- EnterAsTab component"/>
|
||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="1">
|
||||
<Item1>
|
||||
<Filename Value="..\design\JvCmp\jvcmpreg.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="JvCmpReg"/>
|
||||
</Item1>
|
||||
</Files>
|
||||
<RequiredPkgs Count="4">
|
||||
<Item1>
|
||||
<PackageName Value="JvCoreLazD"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<PackageName Value="JvCmpR"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<PackageName Value="FCL"/>
|
||||
</Item4>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
@ -9,7 +9,6 @@
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="..\run\JvJans"/>
|
||||
<OtherUnitFiles Value="..\design\JvJans"/>
|
||||
<UnitOutputDirectory Value="..\lib\$(TargetCPU)-$(TargetOS)\design\JvJans"/>
|
||||
</SearchPaths>
|
||||
|
@ -17,7 +17,7 @@
|
||||
- Simulation components"/>
|
||||
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
|
||||
<Version Major="1" Release="4"/>
|
||||
<Files Count="7">
|
||||
<Files Count="10">
|
||||
<Item1>
|
||||
<Filename Value="..\run\JvJans\JvYearGrid.pas"/>
|
||||
<UnitName Value="JvYearGrid"/>
|
||||
@ -46,6 +46,18 @@
|
||||
<Filename Value="..\run\JvJans\JvSimScope.pas"/>
|
||||
<UnitName Value="JvSimScope"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Filename Value="..\run\JvJans\JvMarkupCommon.pas"/>
|
||||
<UnitName Value="JvMarkupCommon"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Filename Value="..\run\JvJans\JvMarkupViewer.pas"/>
|
||||
<UnitName Value="JvMarkupViewer"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="..\run\JvJans\JvMarkupLabel.pas"/>
|
||||
<UnitName Value="JvMarkupLabel"/>
|
||||
</Item10>
|
||||
</Files>
|
||||
<RequiredPkgs Count="2">
|
||||
<Item1>
|
||||
|
BIN
components/jvcllaz/resource/jvcmpreg.res
Normal file
BIN
components/jvcllaz/resource/jvcmpreg.res
Normal file
Binary file not shown.
Binary file not shown.
@ -30,8 +30,6 @@ unit JvHint;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
//{.$I jvcl.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
|
@ -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):
|
||||
|
@ -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
|
||||
|
236
components/jvcllaz/run/JvJans/JvMarkupCommon.pas
Normal file
236
components/jvcllaz/run/JvJans/JvMarkupCommon.pas
Normal file
@ -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.
|
644
components/jvcllaz/run/JvJans/JvMarkupLabel.pas
Normal file
644
components/jvcllaz/run/JvJans/JvMarkupLabel.pas
Normal file
@ -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.
|
618
components/jvcllaz/run/JvJans/JvMarkupViewer.pas
Normal file
618
components/jvcllaz/run/JvJans/JvMarkupViewer.pas
Normal file
@ -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.
|
Reference in New Issue
Block a user