How to draw fade out text on a custom TGraphicControl?

This should get you started:

unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm5 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    procedure FadeLast50px;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;

implementation

{$R *.dfm}

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 TForm5.FadeLast50px;
var
  bm: TBitmap;
begin
  bm := TBitmap.Create;
  try
    bm.SetSize(50, ClientHeight);
    BitBlt(bm.Canvas.Handle, 0, 0, 50, ClientHeight,
      Canvas.Handle, ClientWidth - 50, 0, SRCCOPY);
    FadeBMToWhite(bm);
    BitBlt(Canvas.Handle, ClientWidth - 50, 0, 50, ClientHeight,
      bm.Canvas.Handle, 0, 0, SRCCOPY);
  finally
    bm.Free;
  end;
end;

procedure TForm5.FormPaint(Sender: TObject);
const
  S = 'This is a string.';
var
  w: integer;
  r: TRect;
begin
  Canvas.Font.Size := 20;
  w := Canvas.TextWidth(S);
  r := ClientRect;
  DrawText(Canvas.Handle, S, Length(S), r, DT_SINGLELINE or DT_VCENTER);
  if w > ClientWidth then
    FadeLast50px;
end;

procedure TForm5.FormResize(Sender: TObject);
begin
  Invalidate;
end;

end.

Screenshot

Compiled demo EXE


Update

Here's a simple experiment with a background:

unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs;

type
  TForm5 = class(TForm)
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form5: TForm5;
  bk: TBitmap;

implementation

{$R *.dfm}

const
  BLENDWIDTH = 100;

type
  PRGB32Array = ^TRGB32Array;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad)-1] of TRGBQuad;

procedure FadeBM(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
        rgbReserved := Round(255*x/w);
        rgbRed := rgbRed * rgbReserved div 255;
        rgbGreen := rgbGreen * rgbReserved div 255;
        rgbBlue := rgbBlue * rgbReserved div 255;
      end;
  end;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  bk := TBitmap.Create;
  with TOpenDialog.Create(nil) do
    try
      Filter := 'Windows Bitmap|*.bmp';
      if Execute then
        bk.LoadFromFile(FileName)
    finally
      Free;
    end;
end;

procedure TForm5.FormPaint(Sender: TObject);
const
  S = 'This is a string.';
var
  w: integer;
  r: TRect;
  bf: TBlendFunction;
  bk2: TBitmap;
begin
  // Draw backgrond
  BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, Bk.Canvas.Handle, 0, 0, SRCCOPY);
  // Draw text
  Canvas.Font.Size := 20;
  Canvas.Brush.Style := bsClear;
  w := Canvas.TextWidth(S);
  r := ClientRect;
  DrawText(Canvas.Handle, S, Length(S), r, DT_SINGLELINE or DT_VCENTER);
  if w > ClientWidth then
  begin
    bk2 := TBitmap.Create;
    try
      bk2.SetSize(BLENDWIDTH, ClientHeight);
      BitBlt(bk2.Canvas.Handle, 0, 0, BLENDWIDTH, ClientHeight, Bk.Canvas.Handle, ClientWidth - BLENDWIDTH, 0, SRCCOPY);
      FadeBM(bk2);
      bf.BlendOp := AC_SRC_OVER;
      bf.BlendFlags := 0;
      bf.SourceConstantAlpha := 255;
      bf.AlphaFormat := AC_SRC_ALPHA;
      Windows.AlphaBlend(Canvas.Handle, ClientWidth - BLENDWIDTH, 0, BLENDWIDTH, ClientHeight, bk2.Canvas.Handle, 0, 0, BLENDWIDTH, ClientHeight, bf);
    finally
      bk2.Free;
    end;
  end;
end;

procedure TForm5.FormResize(Sender: TObject);
begin
  Invalidate;
end;

end.

Screenshot

Compiled demo EXE

Sample background bitmap


Hereby Andreas' code (votes should be for him!) incorporated into a stand alone component:

unit FadingTextControl;

interface

uses
  Classes, Controls, Windows, Graphics;

type
  TFadingTextControl = class(TGraphicControl)
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Caption;
    property Font;
  end;

implementation

{ TFadingTextControl }

constructor TFadingTextControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csOpaque];
end;

procedure TFadingTextControl.Paint;
const
  FadeWidth = 100;
var
  R: TRect;
  Overlay: TBitmap;
  BlendFunc: TBlendFunction;

  procedure FadeOverlay;
  type
    PRGB32Array = ^TRGB32Array;
    TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad) - 1] of TRGBQuad;
  var
    W: Integer;
    Y: Integer;
    Line: PRGB32Array;
    X: Integer;
  begin
    Overlay.PixelFormat := pf32bit;
    W := Overlay.Width;
    for Y := 0 to Overlay.Height - 1 do
    begin
      Line := Overlay.ScanLine[Y];
      for X := 0 to W - 1 do
        with Line[X] do
        begin
          rgbReserved := Round(255 * X / W);
          rgbRed := rgbRed * rgbReserved div 255;
          rgbGreen := rgbGreen * rgbReserved div 255;
          rgbBlue := rgbBlue * rgbReserved div 255;
        end;
    end;
  end;

begin
  R := ClientRect;
  Canvas.Font.Assign(Font);
  Canvas.Brush.Style := bsClear;
  if Canvas.TextWidth(Caption) <= Width then
    DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_SINGLELINE or DT_VCENTER)
  else
  begin
    Overlay := TBitmap.Create;
    try
      Overlay.Width := FadeWidth;
      Overlay.Height := Height;
      BitBlt(Overlay.Canvas.Handle, 0, 0, FadeWidth, Height, Canvas.Handle,
        Width - FadeWidth, 0, SRCCOPY);
      DrawText(Canvas.Handle, PChar(Caption), -1, R, DT_SINGLELINE or
        DT_VCENTER);
      FadeOverlay;
      BlendFunc.BlendOp := AC_SRC_OVER;
      BlendFunc.BlendFlags := 0;
      BlendFunc.SourceConstantAlpha := 255;
      BlendFunc.AlphaFormat := AC_SRC_ALPHA;
      AlphaBlend(Canvas.Handle, Width - FadeWidth, 0, FadeWidth, Height,
        Overlay.Canvas.Handle, 0, 0, FadeWidth, Height, BlendFunc);
    finally
      Overlay.Free;
    end;
  end;
end;

end.