Skip to content

Commit 2f4a75a

Browse files
digao-dalpiazdigao-dalpiaz
authored
Merge pull request #99 from digao-dalpiaz/vcl-styles-full
Vcl styles full
2 parents 79ce4d3 + 3ea5325 commit 2f4a75a

File tree

6 files changed

+57
-40
lines changed

6 files changed

+57
-40
lines changed

‎CompInstall.ini‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@ IniVersion=2
33

44
[General]
55
Name=Digao Dalpiaz - DzHTMLText component
6-
Version=6.8
6+
Version=6.9
77
DelphiVersions=XE3;XE4;XE5;XE6;XE7;XE8;10;10.1;10.2;10.3;10.4;11;12
88
Packages=DzHTMLText_VCL;DzHTMLText_FMX;DzHTMLTextDesign_VCL;DzHTMLTextDesign_FMX
99
AddLibrary=1

‎Example/UFrmExample.pas‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,7 @@ TForm1 = class(TForm)
1313
Lb3: TDzHTMLText;
1414
procedure FormCreate(Sender: TObject);
1515
procedure LbRetrieveImgRes(Sender: TObject; const ResourceName: string;
16-
Picture: TPicture; var Handled: Boolean);
16+
Picture: TAnyPicture; var Handled: Boolean);
1717
procedure LbLinkClick(Sender: TObject; Link: TDHBaseLink;
1818
var Handled: Boolean);
1919
end;
@@ -43,7 +43,7 @@ procedure TForm1.LbLinkClick(Sender: TObject; Link: TDHBaseLink;
4343
end;
4444

4545
procedure TForm1.LbRetrieveImgRes(Sender: TObject; const ResourceName: string;
46-
Picture: TPicture; var Handled: Boolean);
46+
Picture: TAnyPicture; var Handled: Boolean);
4747
begin
4848
if ResourceName='LOGO' then
4949
begin

‎README.md‎

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -39,14 +39,20 @@
3939

4040
## What's New
4141

42-
- 03/15/2025 (Version 6.8)
42+
- 08/16/2025 (Version 6.9)
4343

44-
- Right-to-left (RTL) text supporting.
45-
- When using a Div without "keep properties" (default), now Horizontal Text Alignment get the same value as component pre-defined Horizontal Alignment.
44+
- Fixed full VCL Themes support
45+
- Fixed images scaling in VCL when using ImageList with Scaled=True
46+
- Fixed internal builder order in VCL to avoid incorrect construction when loading form with scaling
4647

4748
<details>
4849
<summary>Click here to view the entire changelog</summary>
4950

51+
- 03/15/2025 (Version 6.8)
52+
53+
- Right-to-left (RTL) text supporting.
54+
- When using a Div without "keep properties" (default), now Horizontal Text Alignment get the same value as component pre-defined Horizontal Alignment.
55+
5056
- 01/26/2025 (Version 6.7)
5157

5258
- Fixed Lazarus compiling (GDI+ units)

‎Source/Vcl.DHCommon.pas‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -46,13 +46,13 @@ TDHCharUtils = class
4646

4747
function SplitStr(const Str, Separator: string; var Left: string; var Right: string): Boolean;
4848

49-
procedure DefineFontColor(C: TCanvas; Color: TAnyColor);
49+
procedure DefineFontColor(Lb: TDzHTMLText; C: TCanvas; Color: TAnyColor);
5050
function GetGenericFontColor(C: TCanvas): TAnyColor;
5151
procedure DefineFontPt(F: TFont; Pt: TPixels; Lb: TDzHTMLText);
5252
function GetGenericFontPt(F: TFont): TPixels;
5353
procedure DefineFontName(F: TFont; const Name: string);
5454
function GetGenericFontName(F: TFont): string;
55-
procedure DefineFillColor(C: TCanvas; Color: TAnyColor);
55+
procedure DefineFillColor(Lb: TDzHTMLText; C: TCanvas; Color: TAnyColor);
5656
function GetGenericFillColor(C: TCanvas): TAnyColor;
5757

5858
procedure GenericFillRect(Lb: TDzHTMLText; C: TCanvas; R: TAnyRect; FixPrecisionFMX: Boolean = False);
@@ -274,9 +274,9 @@ function ParamToColor(const Param: string): TAnyColor;
274274
end;
275275
end;
276276

277-
procedure DefineFontColor(C: TCanvas; Color: TAnyColor);
277+
procedure DefineFontColor(Lb: TDzHTMLText; C: TCanvas; Color: TAnyColor);
278278
begin
279-
C.{$IFDEF FMX}Stroke{$ELSE}Font{$ENDIF}.Color := Color;
279+
C.{$IFDEF FMX}Stroke{$ELSE}Font{$ENDIF}.Color := Lb.GetRealColor(Color);
280280
end;
281281

282282
function GetGenericFontColor(C: TCanvas): TAnyColor;
@@ -306,9 +306,9 @@ function GetGenericFontName(F: TFont): string;
306306
Result := F.{$IFDEF FMX}Family{$ELSE}Name{$ENDIF};
307307
end;
308308

309-
procedure DefineFillColor(C: TCanvas; Color: TAnyColor);
309+
procedure DefineFillColor(Lb: TDzHTMLText; C: TCanvas; Color: TAnyColor);
310310
begin
311-
C.{$IFDEF FMX}Fill{$ELSE}Brush{$ENDIF}.Color := Color;
311+
C.{$IFDEF FMX}Fill{$ELSE}Brush{$ENDIF}.Color := Lb.GetRealColor(Color);
312312
end;
313313

314314
function GetGenericFillColor(C: TCanvas): TAnyColor;

‎Source/Vcl.DHTokenEngine.pas‎

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -894,7 +894,10 @@ procedure TDHToken_Image.Process;
894894
var
895895
V: TDHVisualItem_Image;
896896
Size: TAnySize;
897+
IgnoreScale: Boolean;
897898
begin
899+
IgnoreScale := False;
900+
898901
{$IFDEF USE_IMGLST}
899902
if Assigned(Lb.Images) then
900903
begin
@@ -903,12 +906,16 @@ procedure TDHToken_Image.Process;
903906
Size := TAnySize.Create(Width, Height);
904907
{$ELSE}
905908
Size := TAnySize.Create(Lb.Images.Width, Lb.Images.Height);
909+
if Lb.Images.IsScaled then IgnoreScale := True; //imagelist already scaled
906910
{$ENDIF}
907911
end;
908912
{$ENDIF}
909913

910-
Size.Width := Lb.CalcScale(Size.Width);
911-
Size.Height := Lb.CalcScale(Size.Height);
914+
if not IgnoreScale then
915+
begin
916+
Size.Width := Lb.CalcScale(Size.Width);
917+
Size.Height := Lb.CalcScale(Size.Height);
918+
end;
912919

913920
V := TDHVisualItem_Image.Create;
914921
V.ImageIndex := ImageIndex;
@@ -1668,10 +1675,6 @@ constructor TDHBuilder.Create(Lb: TDzHTMLText; Canvas: TCanvas;
16681675
//--Props
16691676
Props := TDHPropsStore.Create;
16701677
Props.FontColor := Lb.{$IFDEF FMX}FontColor{$ELSE}Font.Color{$ENDIF};
1671-
{$IF Defined(DCC) and Defined(VCL)}
1672-
if TStyleManager.IsCustomStyleActive and (seFont in Lb.StyleElements) and not (csDesigning in Lb.ComponentState) then
1673-
Props.FontColor := TStyleManager.ActiveStyle.GetStyleFontColor(TStyleFont.sfWindowTextNormal);
1674-
{$ENDIF}
16751678
Props.BackColor := clNone;
16761679

16771680
Props.Offset.Top := Lb.CalcScale(Lb.Offset.Top);

‎Source/Vcl.DzHTMLText.pas‎

Lines changed: 30 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -319,9 +319,7 @@ TDzHTMLText = class(
319319
private
320320
FAbout: string;
321321

322-
{$IFDEF FMX}
323322
FirstRebuild: Boolean;
324-
{$ENDIF}
325323

326324
VisualItems: TDHVisualItemList;
327325

@@ -516,6 +514,8 @@ TDzHTMLText = class(
516514

517515
property Text: string read GetText write SetText;
518516

517+
function GetRealColor(Color: TAnyColor): TAnyColor;
518+
519519
class function UnescapeHTMLToText(const aHTML: string): string;
520520
class function EscapeTextToHTML(const aText: string): string;
521521
published
@@ -691,7 +691,7 @@ implementation
691691
, Winapi.GDIPOBJ, Winapi.GDIPAPI
692692
{$ENDIF};
693693

694-
const STR_VERSION = '6.8';
694+
const STR_VERSION = '6.9';
695695

696696
const DEFAULT_PPI = 96;
697697

@@ -945,7 +945,7 @@ procedure TDzHTMLText.Loaded;
945945
is not fired, because there is nothing to load. The Loaded is only fired
946946
when loading component that already has saved properties on DFM file.}
947947
inherited;
948-
Rebuild;
948+
//Rebuild - now in Paint event (just once)
949949
end;
950950

951951
procedure TDzHTMLText.Modified(Flags: TDHModifiedFlags);
@@ -1245,13 +1245,21 @@ procedure TDzHTMLText.Resize;
12451245
inherited;
12461246
end;
12471247

1248+
function TDzHTMLText.GetRealColor(Color: TAnyColor): TAnyColor;
1249+
begin
1250+
{$IF Defined(DCC) and Defined(VCL)}
1251+
if (Color<>clNone) and (seFont in StyleElements) {and not (csDesigning in ComponentState)} then
1252+
Result := StyleServices.GetSystemColor(Color)
1253+
else
1254+
{$ENDIF}
1255+
Result := Color;
1256+
end;
1257+
12481258
procedure TDzHTMLText.Paint;
12491259
begin
12501260
inherited;
12511261

1252-
{$IFDEF FMX}
12531262
if not FirstRebuild then Rebuild;
1254-
{$ENDIF}
12551263

12561264
ExecPaint;
12571265
end;
@@ -1314,8 +1322,8 @@ procedure TDzHTMLText.CanvasProcess(C: TCanvas);
13141322
C.Brush.Color := GetColorresolvingParent
13151323
else
13161324
{$ELSE}
1317-
if TStyleManager.IsCustomStyleActive and (seClient in StyleElements) and not (csDesigning in ComponentState) then
1318-
C.Brush.Color := TStyleManager.ActiveStyle.GetStyleColor(TStyleColor.scWindow)
1325+
if (seClient in StyleElements) {and not (csDesigning in ComponentState)} then
1326+
C.Brush.Color := StyleServices.GetSystemColor(Color)
13191327
else
13201328
{$ENDIF}
13211329
C.Brush.Color := Color;
@@ -1353,14 +1361,13 @@ procedure TDzHTMLText.Paint_VisualItem(W: TDHVisualItem; C: TCanvas);
13531361
begin
13541362
R := W.Rect;
13551363

1356-
DefineFillColor(C, W.BColor);
1364+
DefineFillColor(Self, C, W.BColor);
13571365

13581366
if W is TDHVisualItem_Word then
13591367
begin
13601368
C.Font.Assign(TDHVisualItem_Word(W).Font);
1361-
{$IFDEF FMX}
1362-
C.Stroke.Color := TDHVisualItem_Word(W).FontColor;
1363-
{$ENDIF}
1369+
DefineFontColor(Self, C,
1370+
{$IFDEF FMX}TDHVisualItem_Word(W).FontColor{$ELSE}C.Font.Color{$ENDIF});
13641371
end;
13651372

13661373
if Assigned(W.Link) then
@@ -1437,14 +1444,14 @@ procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div);
14371444
begin
14381445
if (Side.Thick=0) or (Side.Color=clNone) then Exit;
14391446

1440-
DefineFillColor(C, Side.Color);
1447+
DefineFillColor(Self, C, Side.Color);
14411448
GenericFillRect(Self, C, TAnyRect.Create(TAnyPoint.Create(R.Left+X, R.Top+Y), W, H));
14421449
end;
14431450

14441451
begin
14451452
if W.OuterColor<>clNone then
14461453
begin
1447-
DefineFillColor(C, W.OuterColor);
1454+
DefineFillColor(Self, C, W.OuterColor);
14481455
GenericFillRect(Self, C, R);
14491456
end;
14501457

@@ -1456,7 +1463,8 @@ procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div);
14561463
if W.CornerRadius>0 then
14571464
begin
14581465
{$IFDEF USE_GDI}
1459-
PaintRoundRectangleUsingWindowsGDI(C, W.Left.Thick, W.CornerRadius, R, W.Left.Color, W.InnerColor);
1466+
PaintRoundRectangleUsingWindowsGDI(C, W.Left.Thick, W.CornerRadius, R,
1467+
GetRealColor(W.Left.Color), GetRealColor(W.InnerColor));
14601468
{$ELSE}
14611469
if (W.Left.Thick>0) and (W.Left.Color<>clNone) then
14621470
begin
@@ -1466,7 +1474,7 @@ procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div);
14661474
C.Stroke.Kind := TBrushKind.{$IF CompilerVersion >= 27}{XE6}Solid{$ELSE}bkSolid{$ENDIF};
14671475
{$ELSE}
14681476
C.Pen.Width := W.Left.Thick;
1469-
C.Pen.Color := W.Left.Color;
1477+
C.Pen.Color := GetRealColor(W.Left.Color);
14701478
C.Pen.Style := psSolid;
14711479
{$ENDIF}
14721480
end else
@@ -1478,7 +1486,7 @@ procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div);
14781486
{$ENDIF}
14791487
end;
14801488

1481-
DefineFillColor(C, W.InnerColor);
1489+
DefineFillColor(Self, C, W.InnerColor);
14821490

14831491
{$IFDEF FMX}
14841492
C.FillRect(R, W.CornerRadius, W.CornerRadius, AllCorners, Opacity); //backgound
@@ -1491,7 +1499,7 @@ procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div);
14911499
begin
14921500
if W.InnerColor<>clNone then
14931501
begin
1494-
DefineFillColor(C, W.InnerColor);
1502+
DefineFillColor(Self, C, W.InnerColor);
14951503
GenericFillRect(Self, C, R);
14961504
end;
14971505

@@ -1568,14 +1576,14 @@ procedure TDzHTMLText.Paint_Line(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Line)
15681576
if W.ColorAlt <> clNone then
15691577
R.Height := RoundIfVCL(R.Height / 2); //half height when double color
15701578

1571-
DefineFillColor(C, W.Color);
1579+
DefineFillColor(Self, C, W.Color);
15721580
GenericFillRect(Self, C, R);
15731581

15741582
if W.ColorAlt <> clNone then
15751583
begin
15761584
R.Offset(0, R.Height);
15771585

1578-
DefineFillColor(C, W.ColorAlt);
1586+
DefineFillColor(Self, C, W.ColorAlt);
15791587
GenericFillRect(Self, C, R);
15801588
end;
15811589
end;
@@ -1957,8 +1965,8 @@ procedure TDHStyleLinkProp.SetUnderline(const Value: Boolean);
19571965

19581966
procedure TDHStyleLinkProp.SetPropsToCanvas(C: TCanvas);
19591967
begin
1960-
if FFontColor<>clNone then DefineFontColor(C, FFontColor);
1961-
if FBackColor<>clNone then DefineFillColor(C, FBackColor);
1968+
if FFontColor<>clNone then DefineFontColor(Lb, C, FFontColor);
1969+
if FBackColor<>clNone then DefineFillColor(Lb, C, FBackColor);
19621970
if FUnderline then C.Font.Style := C.Font.Style + [TMyFontStyle.fsUnderline];
19631971
end;
19641972

0 commit comments

Comments
 (0)