How to draw transparent text on form?

问题

Is there a way to draw a transparent text on form that has some controls? If I use TLabel control, it would always show behind controls on the form.

回答1:

You cannot use a TLabel control, since it is not a windowed control, and therefore it will be hidden by every windowed child control of the form. You could use a TStaticText, which is indeed a windowed control (a STATIC control), but it will be a bit difficult to make it truly transparent, I'd suppose.

You can use layered windows for this:

1. Create a new VCL project, and add a bunch of windowed controls to it.

2. Create a new form in the project, named splash. Set BorderStyle to bsNone, and set the font name, size, and colour to whatever you desire (e.g., Segoe UI, 42, red).

3. Add a public method

   procedure Tsplash.UpdateSplash(const Str: string);
   var
     R: TRect;
     P: TPoint;
     S: TPoint;
     bm: TBitmap;
     bf: TBlendFunction;
     EXSTYLE: DWORD;
     x, y: integer;
     pixel: PRGBQuad;
     TextRed,
     TextGreen,
     TextBlue: byte;
   begin
     EXSTYLE := GetWindowLong(Handle, GWL_EXSTYLE);
     SetWindowLong(Handle, GWL_EXSTYLE, EXSTYLE or WS_EX_LAYERED);
   
     R := ClientRect;
   
     bm := TBitmap.Create;
     try
       bm.PixelFormat := pf32bit;
       bm.SetSize(ClientWidth, ClientHeight);
   
       bm.Canvas.Brush.Color := clBlack;
       bm.Canvas.FillRect(ClientRect);
   
       bm.Canvas.Font.Assign(Self.Font);
       bm.Canvas.Font.Color := clWhite;
       DrawText(bm.Canvas.Handle, PChar(Str), Length(Str), R,
         DT_SINGLELINE or DT_VCENTER or DT_CENTER or DT_WORD_ELLIPSIS);
   
       TextRed := GetRValue(Font.Color);
       TextGreen := GetGValue(Font.Color);
       TextBlue := GetBValue(Font.Color);
   
       for y := 0 to bm.Height - 1 do
       begin
         pixel := bm.ScanLine[y];
         x := 0;
         while x < bm.Width do
         begin
           with pixel^ do
           begin
             rgbReserved := (rgbRed + rgbGreen + rgbBlue) div 3;
   
             rgbBlue := TextBlue * rgbReserved div 255;
             rgbGreen := TextGreen * rgbReserved div 255;
             rgbRed := TextRed * rgbReserved div 255;
           end;
   
           inc(pixel);
           inc(x);
         end;
       end;
   
       P := Point(0, 0);
       S := Point(bm.Width, bm.Height);
       bf.BlendOp := AC_SRC_OVER;
       bf.BlendFlags := 0;
       bf.SourceConstantAlpha := 255;
       bf.AlphaFormat := AC_SRC_ALPHA;
       UpdateLayeredWindow(Handle, 0, nil, @S, bm.Canvas.Handle, @P, 0, @bf,
         ULW_ALPHA)
     finally
       bm.Free;
     end;
   end;
   

4. To your main form, add private methods

   procedure TForm1.CreateSplash;
   var
     p: TPoint;
   begin
     splash.Visible := true;
     UpdateSplash;
   end;
   
   procedure TForm1.UpdateSplash;
   var
     p: TPoint;
   begin
     if not (Assigned(splash) and splash.Visible) then Exit;
     p := ClientToScreen(Point(0, 0));
     splash.SetBounds(p.X, p.Y, ClientWidth, ClientHeight);
     splash.UpdateSplash('Sample Text');
   end;
   

   and call UpdateSplash every time the form is moved or resized:

   procedure TForm1.WMMove(var Message: TWMMove);
   begin
     UpdateSplash;
   end;
   
   procedure TForm4.FormResize(Sender: TObject);
   begin
     UpdateSplash;
   end;
   

Finally, you can do, just to try it out,

procedure TForm1.FormClick(Sender: TObject);
begin
  if splash.Visible then
    splash.Hide
  else
    CreateSplash;
end;

Compiled demo EXE

来源：https://stackoverflow.com/questions/14460561/how-to-draw-transparent-text-on-form