Question

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

Answer 1

您不能使用TLabel控件，因为它不是窗口控件，因此它将被窗体的每个窗口控件隐藏。您可以使用TStaticText，它确实是一个窗口控件（STATIC控件），但是我认为它确实有点难以实现。

您可以使用分层窗口：

创建一个新的VCL项目，并为其添加一堆窗口控件。
在项目中创建一个名为splash的新表单。将BorderStyle设置为bsNone，并将字体名称，大小和颜色设置为您想要的任何内容（例如，Segoe UI，42，红色）。

添加公开方法

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;

在主表单中添加私有方法

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

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

1 个答案: