diff --git a/CompInstall.ini b/CompInstall.ini index 9ede437..1291538 100644 --- a/CompInstall.ini +++ b/CompInstall.ini @@ -3,7 +3,7 @@ IniVersion=2 [General] Name=Digao Dalpiaz - DzHTMLText component -Version=6.5 +Version=6.6 DelphiVersions=XE3;XE4;XE5;XE6;XE7;XE8;10;10.1;10.2;10.3;10.4;11;12 Packages=DzHTMLText_VCL;DzHTMLText_FMX;DzHTMLTextDesign_VCL;DzHTMLTextDesign_FMX AddLibrary=1 diff --git a/README.md b/README.md index 7469190..cec2996 100644 --- a/README.md +++ b/README.md @@ -38,13 +38,18 @@ ## What's New -- 10/14/2024 (Version 6.5) +- 11/14/2024 (Version 6.6) - - New Corner Radius ("radius") property for Div tag + - Use GDI painting from Windows API when using VCL + Windows to draw rounded div + - Fix access violation when DPI Scaling in VCL (early access to TForm.Monitor)
Click here to view the entire changelog +- 10/14/2024 (Version 6.5) + + - New Corner Radius ("radius") property for Div tag + - 03/26/2024 (Version 6.4) - Fix Delphi XE3 compiling (Design packages and FMX FillRect) diff --git a/Source/Defines.inc b/Source/Defines.inc index 4974a85..df31bbf 100644 --- a/Source/Defines.inc +++ b/Source/Defines.inc @@ -10,6 +10,10 @@ {$DEFINE VCL} {$DEFINE USE_NEW_ENV} {$DEFINE USE_IMGLST} + + {$IFDEF MSWINDOWS} + {$DEFINE USE_GDI} + {$ENDIF} {$ENDIF} {$ZEROBASEDSTRINGS OFF} diff --git a/Source/Vcl.DzHTMLText.pas b/Source/Vcl.DzHTMLText.pas index b36d62e..99e84db 100644 --- a/Source/Vcl.DzHTMLText.pas +++ b/Source/Vcl.DzHTMLText.pas @@ -35,6 +35,8 @@ interface {$INCLUDE Types.inc} type + TMyFontStyle = TFontStyle; + TDzHTMLText = class; TDHLinkKind = (lkLinkRef, lkSpoiler); @@ -678,9 +680,12 @@ implementation {$IFDEF MSWINDOWS} , Winapi.Windows, Winapi.ShellAPI {$ENDIF} +{$ENDIF} +{$IFDEF USE_GDI} + , Winapi.GDIPOBJ, Winapi.GDIPAPI {$ENDIF}; -const STR_VERSION = '6.5'; +const STR_VERSION = '6.6'; const DEFAULT_PPI = 96; @@ -1370,6 +1375,46 @@ procedure TDzHTMLText.Paint_VisualItem(W: TDHVisualItem; C: TCanvas); raise EDHInternalExcept.Create('Invalid visual item object'); end; +{$IFDEF USE_GDI} +function ToGPColor(Color: TColor): TGPColor; +var + ColRef: COLORREF; +begin + ColRef := ColorToRGB(Color); + Result := MakeColor(GetRValue(ColRef), GetGValue(ColRef), GetBValue(ColRef)); +end; + +procedure PaintRoundRectangleUsingWindowsGDI(Canvas: TCanvas; Thick, Radius: Single; Rect: TRect; PenColor, BrushColor: TColor); +var + Gpx: TGPGraphics; + Pen: TGPPen; + Path: TGPGraphicsPath; + Brush: TGPSolidBrush; +begin + Gpx := TGPGraphics.Create(Canvas.Handle); + Pen := TGPPen.Create(ToGPColor(PenColor), Thick); + Brush := TGPSolidBrush.Create(ToGPColor(BrushColor)); + Path := TGPGraphicsPath.Create; + try + Gpx.SetSmoothingMode(SmoothingModeAntiAlias); + + Path.AddArc(Rect.Left, Rect.Top, Radius, Radius, 180, 90); + Path.AddArc(Rect.Left + Rect.Width - Radius, Rect.Top, Radius, Radius, 270, 90); + Path.AddArc(Rect.Left + Rect.Width - Radius, Rect.Top + Rect.Height - Radius, Radius, Radius, 0, 90); + Path.AddArc(Rect.Left, Rect.Top + Rect.Height - Radius, Radius, Radius, 90, 90); + Path.CloseFigure; + + if BrushColor<>clNone then Gpx.FillPath(Brush, Path); + if (PenColor<>clNone) and (Thick>0) then Gpx.DrawPath(Pen, Path); + finally + Path.Free; + Brush.Free; + Pen.Free; + Gpx.Free; + end; +end; +{$ENDIF} + procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div); procedure PaintSide(var Side: TDHDivBorderLineAttrRec; X, Y, W, H: TPixels); @@ -1394,6 +1439,9 @@ procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div); if W.CornerRadius>0 then begin + {$IFDEF USE_GDI} + PaintRoundRectangleUsingWindowsGDI(C, W.Left.Thick, W.CornerRadius, R, W.Left.Color, W.InnerColor); + {$ELSE} if (W.Left.Thick>0) and (W.Left.Color<>clNone) then begin {$IFDEF FMX} @@ -1422,6 +1470,7 @@ procedure TDzHTMLText.Paint_Div(C: TCanvas; R: TAnyRect; W: TDHVisualItem_Div); {$ELSE} C.RoundRect(R, W.CornerRadius, W.CornerRadius); {$ENDIF} + {$ENDIF} end else begin if W.InnerColor<>clNone then @@ -1696,7 +1745,7 @@ function TDzHTMLText.CalcMulDiv(Size: Integer): Integer; {$ENDIF} begin {$IFDEF PPI_SCALING} - if (ParentForm<>nil) and THackForm(ParentForm).Scaled + if (ParentForm<>nil) and THackForm(ParentForm).Scaled and (ParentForm.Monitor<>nil) {$IFDEF DCC}and not (csDesigning in ComponentState){$ENDIF} //design always based on Default PPI in Delphi then begin @@ -1894,7 +1943,7 @@ procedure TDHStyleLinkProp.SetPropsToCanvas(C: TCanvas); begin if FFontColor<>clNone then DefineFontColor(C, FFontColor); if FBackColor<>clNone then DefineFillColor(C, FBackColor); - if FUnderline then C.Font.Style := C.Font.Style + [TFontStyle.fsUnderline]; + if FUnderline then C.Font.Style := C.Font.Style + [TMyFontStyle.fsUnderline]; end; procedure TDHStyleLinkProp.Assign(Source: TPersistent);