I would like to draw fade-out text on a TGraphicControl, something like the tabs on Google Chrome, when there isn't enough space to display the whole text on the Canvas.
So instead of displaying elipsis text (which I know how to do), I want it to fade out like this: 
The TGraphicControl needs to have transparent option like TCustomLabel (ControlStyle - [csOpaque]).
This is probably an easy task with GDIPlus but I need to use pure GDI.
I also try to study the code of TGradText v.1.0 (Direct download) which does (almost) exactly what I need - it can draw transparent text but the result looks very bad and not smooth. I guess it's because it makes a pmCopy mask for this task.
Here is the code I wrote based on Andreas Rejbrand answer. I used a PaintBox over a TImage and prerendered the backgound:
type
TParentControl = class(TWinControl);
{ This procedure is copied from RxLibrary VCLUtils }
procedure CopyParentImage(Control: TControl; Dest: TCanvas);
var
I, Count, X, Y, SaveIndex: Integer;
DC: HDC;
R, SelfR, CtlR: TRect;
begin
if (Control = nil) or (Control.Parent = nil) then Exit;
Count := Control.Parent.ControlCount;
DC := Dest.Handle;
with Control.Parent do ControlState := ControlState + [csPaintCopy];
try
with Control do
begin
SelfR := Bounds(Left, Top, Width, Height);
X := -Left; Y := -Top;
end;
{ Copy parent control image }
SaveIndex := SaveDC(DC);
try
SetViewportOrgEx(DC, X, Y, nil);
IntersectClipRect(DC, 0, 0, Control.Parent.ClientWidth,
Control.Parent.ClientHeight);
with TParentControl(Control.Parent) do
begin
Perform(WM_ERASEBKGND, DC, 0);
PaintWindow(DC);
end;
finally
RestoreDC(DC, SaveIndex);
end;
{ Copy images of graphic controls }
for I := 0 to Count - 1 do begin
if Control.Parent.Controls[I] = Control then Break
else if (Control.Parent.Controls[I] <> nil) and
(Control.Parent.Controls[I] is TGraphicControl) then
begin
with TGraphicControl(Control.Parent.Controls[I]) do begin
CtlR := Bounds(Left, Top, Width, Height);
if Bool(IntersectRect(R, SelfR, CtlR)) and Visible then begin
ControlState := ControlState + [csPaintCopy];
SaveIndex := SaveDC(DC);
try
SetViewportOrgEx(DC, Left + X, Top + Y, nil);
IntersectClipRect(DC, 0, 0, Width, Height);
Perform(WM_PAINT, DC, 0);
finally
RestoreDC(DC, SaveIndex);
ControlState := ControlState - [csPaintCopy];
end;
end;
end;
end;
end;
finally
with Control.Parent do ControlState := ControlState - [csPaintCopy];
end;
end;
type
PRGB32Array = ^TRGB32Array;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad;
procedure FadeBMToWhite(Bitmap: TBitmap);
var
w, h: integer;
y: Integer;
sl: PRGB32Array;
x: Integer;
begin
Bitmap.PixelFormat := pf32bit;
w := Bitmap.Width;
h := Bitmap.Height;
for y := 0 to h - 1 do
begin
sl := Bitmap.ScanLine[y];
for x := 0 to w - 1 do
with sl[x] do
begin
rgbBlue := rgbBlue + x * ($FF - rgbBlue) div w;
rgbGreen := rgbGreen + x * ($FF - rgbGreen) div w;
rgbRed := rgbRed + x * ($FF - rgbRed) div w;
end;
end;
end;
procedure FadeLastNpx(Canvas: TCanvas; N: Integer; ClientWidth, ClientHeight: Integer);
var
bm: TBitmap;
begin
bm := TBitmap.Create;
try
bm.Width := N;
bm.Height := ClientHeight;
BitBlt(bm.Canvas.Handle, 0, 0, N, ClientHeight,
Canvas.Handle, ClientWidth - N, 0, SRCCOPY);
FadeBMToWhite(bm);
BitBlt(Canvas.Handle, ClientWidth - N, 0, N, ClientHeight,
bm.Canvas.Handle, 0, 0, SRCCOPY);
finally
bm.Free;
end;
end;
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
w: integer;
r: TRect;
S: string;
CurScreen: TBitmap; // offscreen bitmap to speed things up
begin
with PaintBox1 do
begin
CurScreen := TBitmap.Create;
CurScreen.Width := Width;
CurScreen.Height := Height;
CopyParentImage(PaintBox1, CurScreen.Canvas);
with CurScreen do
begin
Canvas.Font.Assign(PaintBox1.Font);
S := 'This is a string.';
Canvas.Font.Size := 20;
w := Canvas.TextWidth(S);
r := ClientRect;
Canvas.FrameRect(r); // for testing
Canvas.Brush.Style := bsClear;
DrawText(Canvas.Handle, PChar(S), Length(S), r, DT_SINGLELINE or DT_VCENTER);
if w > ClientWidth then
FadeLastNpx(Canvas, 50, ClientWidth, ClientHeight);
end; // with CurScreen
Canvas.Draw(0, 0, CurScreen);
end; // with PaintBox1
CurScreen.Free;
end;
The result looks like this:
As you can see the right egde of the background is also faded. it looks nice. but I wonder if only the text could be faded with TLama sugeestion?
this questionwhich asked for the same effect in GDI+ (just to make this question linked with the other one). – Sophroniathis questionwhich asked for the same effect in GDI+ (just to make this question linked with the other one). – Sophronia