如何在表单上绘制透明文字？

Question

有没有办法在具有一些控件的表单上绘制透明文本？如果我使用TLabel控件,它将始终显示在窗体上的控件后面.

Answer 1

您不能使用TLabel控件,因为它不是窗口控件,因此它将被窗体的每个窗口控件隐藏.你可以使用a TStaticText,它实际上是一个窗口控件(一个STATIC控件),但是我认为让它真正透明有点困难.

您可以使用分层窗口:

1. 创建一个新的VCL项目,并向其添加一堆窗口控件.

2. 在项目中创建一个名为的新表单splash.设置BorderStyle为bsNone,并将字体名称,大小和颜色设置为您想要的任何内容(例如,Segoe UI,42,红色).

3. 添加公共方法

   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. 在主窗体中,添加私有方法

   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;
   

   UpdateSplash每次移动或调整表单时调用:

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

最后,你可以做,只是试一试,

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

示例截图http://privat.rejbrand.se/layeralpha.png

编译演示EXE