Przeglądaj źródła

When I updated TNewStaticText to the current TStaticText in ec9b7dcb I removed the Transparent property from it. Bring it back optionally because some styles seem to depend on it. Might also improve things when it's not included because it now properly sets csOpaque.

Martijn Laan 1 tydzień temu
rodzic
commit
cd98d3e0f8
1 zmienionych plików z 64 dodań i 9 usunięć
  1. 64 9
      Components/NewStaticText.pas

+ 64 - 9
Components/NewStaticText.pas

@@ -4,7 +4,7 @@ unit NewStaticText;
   TNewStaticText - similar to TStaticText but with multi-line AutoSize
   support and a WordWrap property, and without a Transparent property.
 
-  Define VCLSTYLES for full VCL Styles support.
+  Define VCLSTYLES for full VCL Styles support, and for transparency support.
 }
 
 interface
@@ -12,6 +12,10 @@ interface
 uses
   Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, Themes;
 
+{$IFDEF VCLSTYLES}
+  {$DEFINE TRANSPARENCYSUPPORT}
+{$ENDIF}
+
 type
   TNewStaticText = class(TWinControl)
   private
@@ -23,6 +27,9 @@ type
     FWordWrap: Boolean;
     class constructor Create;
     class destructor Destroy;
+    {$IFDEF TRANSPARENCYSUPPORT}
+    procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
+    {$ENDIF}
     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
@@ -33,7 +40,9 @@ type
     procedure SetFocusControl(Value: TWinControl);
     procedure SetForceLTRReading(Value: Boolean);
     procedure SetShowAccelChar(Value: Boolean);
+    procedure SetTransparent(const Value: Boolean);
     procedure SetWordWrap(Value: Boolean);
+    function GetTransparent: Boolean;
   protected
     procedure CreateParams(var Params: TCreateParams); override;
     procedure Loaded; override;
@@ -66,6 +75,8 @@ type
     property StyleName;
     property TabOrder;
     property TabStop;
+    property Transparent: Boolean read GetTransparent write SetTransparent
+      default True;
     property Visible;
     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
     property OnClick;
@@ -107,6 +118,9 @@ begin
   inherited Create(AOwner);
   ControlStyle := [csCaptureMouse, csClickEvents, csSetCaption,
     csReplicatable, csDoubleClicks, csGestures {$IF CompilerVersion >= 35.0}, csNeedsDesignDisabledState{$ENDIF}];
+  {$IFNDEF TRANSPARENCYSUPPORT}
+  ControlStyle := ControlStyle + [csOpaque];
+  {$ENDIF}
   Width := 65;
   Height := 17;
   FAutoSize := True;
@@ -300,6 +314,44 @@ begin
   end;
 end;
 
+{$IFDEF TRANSPARENCYSUPPORT}
+procedure TNewStaticText.CNCtlColorStatic(var Message: TWMCtlColorStatic);
+begin
+  if StyleServices(Self).Enabled and Transparent then
+  begin
+    SetBkMode(Message.ChildDC, Windows.TRANSPARENT);
+    StyleServices(Self).DrawParentBackground(Handle, Message.ChildDC, nil, False);
+    { Return an empty brush to prevent Windows from overpainting what we just have created. }
+    Message.Result := GetStockObject(NULL_BRUSH);
+  end
+  else
+    inherited;
+end;
+{$ENDIF}
+
+procedure TNewStaticText.SetTransparent(const Value: Boolean);
+begin
+{$IFDEF TRANSPARENCYSUPPORT}
+  if Transparent <> Value then
+  begin
+    if Value then
+      ControlStyle := ControlStyle - [csOpaque]
+    else
+      ControlStyle := ControlStyle + [csOpaque];
+    Invalidate;
+  end;
+{$ENDIF}
+end;
+
+function TNewStaticText.GetTransparent: Boolean;
+begin
+{$IFDEF TRANSPARENCYSUPPORT}
+  Result := not (csOpaque in ControlStyle);
+{$ELSE}
+  Result := False;
+{$ENDIF}
+end;
+
 procedure TNewStaticText.SetWordWrap(Value: Boolean);
 begin
   if FWordWrap <> Value then
@@ -314,8 +366,7 @@ end;
 
 { TNewStaticTextStyleHook - same as Vcl.StdCtrls' TStaticTextStyleHook
   except that it accesses the Control property as a TNewStaticText instead
-  of a TCustomStaticText or TStaticText, and with code related to the
-  Transparent property removed }
+  of a TCustomStaticText or TStaticText }
 
 type
   TControlAccess = class(TControl);
@@ -340,19 +391,23 @@ var
 begin
   LStyle := StyleServices;
 
-  if LStyle.Available then
-  begin
+  if LStyle.Available then begin
     R := Control.ClientRect;
-    Canvas.Brush.Color := LStyle.GetStyleColor(scWindow);
-    Canvas.FillRect(R);
+    if TNewStaticText(Control).Transparent then begin
+      Details := LStyle.GetElementDetails(tbCheckBoxUncheckedNormal);
+      LStyle.DrawParentBackground(Handle, Canvas.Handle, Details, False);
+      Canvas.Brush.Style := bsClear;
+    end else begin
+      Canvas.Brush.Color := LStyle.GetStyleColor(scWindow);
+      Canvas.FillRect(R);
+    end;
     Details := LStyle.GetElementDetails(States[Control.Enabled]);
     S := TNewStaticText(Control).Caption;
     if (S = '') or (TNewStaticText(Control).FShowAccelChar and (S[1] = '&') and (S[2] = #0)) then
       S := S + ' ';
     if seFont in Control.StyleElements then
       DrawControlText(Canvas, Details, S, R, TNewStaticText(Control).GetDrawTextFlags)
-    else
-    begin
+    else begin
       Canvas.Font := TNewStaticText(Control).Font;
       DrawText(Canvas.Handle, S, Length(S), R, TNewStaticText(Control).GetDrawTextFlags);
     end;