如何在窗體上繪製透明文本？

Question

有沒有辦法在窗體上繪製具有一些控件的透明文本？如果我使用TLabel控件，它將始終顯示在窗體上的控件背後。

Answer 1

您不能使用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 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; 

Sample screenshot http://privat.rejbrand.se/layeralpha.png

Compiled demo EXE