Merge pull request #95 from digao-dalpiaz/gdi-paint

Gdi paint

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

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)
 
 <details>
   <summary>Click here to view the entire changelog</summary>
 
+- 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)

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}

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);