瀏覽代碼

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 周之前
父節點
當前提交
cd98d3e0f8
共有 1 個文件被更改,包括 64 次插入9 次删除
  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
   TNewStaticText - similar to TStaticText but with multi-line AutoSize
   support and a WordWrap property, and without a Transparent property.
   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
 interface
@@ -12,6 +12,10 @@ interface
 uses
 uses
   Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, Themes;
   Windows, Messages, SysUtils, Classes, Controls, Forms, Graphics, Themes;
 
 
+{$IFDEF VCLSTYLES}
+  {$DEFINE TRANSPARENCYSUPPORT}
+{$ENDIF}
+
 type
 type
   TNewStaticText = class(TWinControl)
   TNewStaticText = class(TWinControl)
   private
   private
@@ -23,6 +27,9 @@ type
     FWordWrap: Boolean;
     FWordWrap: Boolean;
     class constructor Create;
     class constructor Create;
     class destructor Destroy;
     class destructor Destroy;
+    {$IFDEF TRANSPARENCYSUPPORT}
+    procedure CNCtlColorStatic(var Message: TWMCtlColorStatic); message CN_CTLCOLORSTATIC;
+    {$ENDIF}
     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
     procedure CMParentFontChanged(var Message: TMessage); message CM_PARENTFONTCHANGED;
@@ -33,7 +40,9 @@ type
     procedure SetFocusControl(Value: TWinControl);
     procedure SetFocusControl(Value: TWinControl);
     procedure SetForceLTRReading(Value: Boolean);
     procedure SetForceLTRReading(Value: Boolean);
     procedure SetShowAccelChar(Value: Boolean);
     procedure SetShowAccelChar(Value: Boolean);
+    procedure SetTransparent(const Value: Boolean);
     procedure SetWordWrap(Value: Boolean);
     procedure SetWordWrap(Value: Boolean);
+    function GetTransparent: Boolean;
   protected
   protected
     procedure CreateParams(var Params: TCreateParams); override;
     procedure CreateParams(var Params: TCreateParams); override;
     procedure Loaded; override;
     procedure Loaded; override;
@@ -66,6 +75,8 @@ type
     property StyleName;
     property StyleName;
     property TabOrder;
     property TabOrder;
     property TabStop;
     property TabStop;
+    property Transparent: Boolean read GetTransparent write SetTransparent
+      default True;
     property Visible;
     property Visible;
     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
     property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
     property OnClick;
     property OnClick;
@@ -107,6 +118,9 @@ begin
   inherited Create(AOwner);
   inherited Create(AOwner);
   ControlStyle := [csCaptureMouse, csClickEvents, csSetCaption,
   ControlStyle := [csCaptureMouse, csClickEvents, csSetCaption,
     csReplicatable, csDoubleClicks, csGestures {$IF CompilerVersion >= 35.0}, csNeedsDesignDisabledState{$ENDIF}];
     csReplicatable, csDoubleClicks, csGestures {$IF CompilerVersion >= 35.0}, csNeedsDesignDisabledState{$ENDIF}];
+  {$IFNDEF TRANSPARENCYSUPPORT}
+  ControlStyle := ControlStyle + [csOpaque];
+  {$ENDIF}
   Width := 65;
   Width := 65;
   Height := 17;
   Height := 17;
   FAutoSize := True;
   FAutoSize := True;
@@ -300,6 +314,44 @@ begin
   end;
   end;
 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);
 procedure TNewStaticText.SetWordWrap(Value: Boolean);
 begin
 begin
   if FWordWrap <> Value then
   if FWordWrap <> Value then
@@ -314,8 +366,7 @@ end;
 
 
 { TNewStaticTextStyleHook - same as Vcl.StdCtrls' TStaticTextStyleHook
 { TNewStaticTextStyleHook - same as Vcl.StdCtrls' TStaticTextStyleHook
   except that it accesses the Control property as a TNewStaticText instead
   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
 type
   TControlAccess = class(TControl);
   TControlAccess = class(TControl);
@@ -340,19 +391,23 @@ var
 begin
 begin
   LStyle := StyleServices;
   LStyle := StyleServices;
 
 
-  if LStyle.Available then
-  begin
+  if LStyle.Available then begin
     R := Control.ClientRect;
     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]);
     Details := LStyle.GetElementDetails(States[Control.Enabled]);
     S := TNewStaticText(Control).Caption;
     S := TNewStaticText(Control).Caption;
     if (S = '') or (TNewStaticText(Control).FShowAccelChar and (S[1] = '&') and (S[2] = #0)) then
     if (S = '') or (TNewStaticText(Control).FShowAccelChar and (S[1] = '&') and (S[2] = #0)) then
       S := S + ' ';
       S := S + ' ';
     if seFont in Control.StyleElements then
     if seFont in Control.StyleElements then
       DrawControlText(Canvas, Details, S, R, TNewStaticText(Control).GetDrawTextFlags)
       DrawControlText(Canvas, Details, S, R, TNewStaticText(Control).GetDrawTextFlags)
-    else
-    begin
+    else begin
       Canvas.Font := TNewStaticText(Control).Font;
       Canvas.Font := TNewStaticText(Control).Font;
       DrawText(Canvas.Handle, S, Length(S), R, TNewStaticText(Control).GetDrawTextFlags);
       DrawText(Canvas.Handle, S, Length(S), R, TNewStaticText(Control).GetDrawTextFlags);
     end;
     end;