Shading TB42Label
Last time, we saw how you could implement a right-aligned editbox by mixing features of TEdit and TMemo.
This time, we'll enhance a regular TLabel component with the ability to paint shades, both lowered and raised (or normal - as in no shades).
There are two way of doing this: the low-level (Windows) way, and the cross-platform way.
Today, we'll see the Windows way, because that's the way I've been doing it (and using) for the past few years.
At a later time, I may explore the cross-platform way (i.e. without using low-level Windows APIs).
The TB42Label supports three styles: lowered, normal and raised.
The idea I used is simple: apart from the current text itself, I also write the text using a black font and a white font.
For a lowered style, the black text is positioned one pixel down and to the right (and the white text one pixel up and to the left).
For a raised style, the positions are swapped, and for a normal style I don't write the white and black texts at all.
For big font sizes, a single pixel may not be enough, which is why I'm also using an Offset - default set to 1, but you can set it to 2 or higher for fontsizes bigger than 16 orso.
unit Label42;
interface
uses
Classes, Controls, StdCtrls, Graphics;
type
TLabelStyle = (lsLowered, lsNormal, lsRaised);
TB42Label = class(TLabel)
private
FOffset: Integer;
FLabelStyle: TLabelStyle;
protected
procedure Paint; override;
protected
procedure SetLabelStyle(NewLabelStyle: TLabelStyle);
procedure SetOffset(NewOffset: Integer);
public
constructor Create(AOwner: TComponent); override;
published
property LabelStyle: TLabelStyle read FLabelStyle write SetLabelStyle;
property Offset: Integer read FOffset write SetOffset;
end;
As you can see in the class definition above, there are two new properties: LabelStyle and Offset (as explained), and we've overruled the constructor as well as the Paint method.
implementation
uses
Windows;
constructor TB42Label.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FOffset := 1;
FLabelStyle := lsLowered;
Transparent := True
end;
procedure TB42Label.SetLabelStyle(NewLabelStyle: TLabelStyle);
begin
if FLabelStyle <> NewLabelStyle then
begin
FLabelStyle := NewLabelStyle;
Invalidate
end
end;
procedure TB42Label.SetOffset(NewOffset: Integer);
begin
if FOffset <> NewOffset then
begin
FOffset := NewOffset;
Invalidate
end
end;
When the LabelStyle or Offset values are modified, the call to Invalidate makes sure the label is painted again (including shades).
The Paint method itself writes the Caption of the TB42Label two more times: first in white (the light) and then in black (the shadow):
procedure TB42Label.Paint;
const
Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
var
CapStr: String;
Len: Integer;
CalcOffset: Integer;
OldColor: TColor;
TempRect: TRect;
begin
CapStr := Caption;
Len := Length(CapStr);
CalcOffset := (Ord(FLabelStyle)-1) * FOffset;
if CalcOffset <> 0 then
try
OldColor := Font.Color;
Canvas.Brush.Style := bsClear;
Canvas.Font := Self.Font;
Canvas.Font.Color := clWhite;
TempRect := Rect(ClientRect.Left - CalcOffset,
ClientRect.Top - CalcOffset,
ClientRect.Right - CalcOffset,
ClientRect.Bottom - CalcOffset);
DrawText(Canvas.Handle, PChar(CapStr), Len, TempRect,
DT_EXPANDTABS or DT_WORDBREAK or Alignments[Alignment]);
Canvas.Font.Color := clBlack;
TempRect := Rect(ClientRect.Left + CalcOffset,
ClientRect.Top + CalcOffset,
ClientRect.Right + CalcOffset,
ClientRect.Bottom + CalcOffset);
DrawText(Canvas.Handle, PChar(CapStr), Len, TempRect,
DT_EXPANDTABS or DT_WORDBREAK or Alignments[Alignment])
finally
Canvas.Font.Color := OldColor
end;
inherited Paint
end;
Epilogue
Clearly, the DrawText function is a Windows API, which is the reason the Windows unit was added to the uses clause - of the implementation section!
A possible cross-platform edition of TB42Label could create two "helper" TLabel components and position them behind itself at the position specified by LabelStyle and Offset (provided we keep Transparent set to True at all times).