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