如何在表单上绘制透明文本？ [英] How to draw transparent text on form?

问题描述

有没有办法在表单上绘制透明文本，有一些控件？如果我使用 TLabel 控件，它将总是显示在窗体上的控件。

解决方案

您不能使用 TLabel 控件，因为它不是一个窗口控件，因此它将被窗体的每个窗口子控件隐藏。你可以使用一个 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或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或DT_VCENTER或DT_CENTER或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（像素）; 
    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 
   如果不是（Assigned（splash）和splash.Visible），然后退出; 
    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 
如果splash.Visible然后
 splash.Hide 
 else 
 CreateSplash; 
 end; 
  

编译演示EXE

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.

解决方案

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

这篇关于如何在表单上绘制透明文本？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！