在图像上写透明文本

6

如何在图像(Jpg,Bmp)上编写半透明文本,或者透明文本(颜色与背景图像相同),但带有阴影,我想要做的是给图像打水印。

我想使用Delphi win32实现这一目标。

6个回答

7

一种选择是使用Windows.pas单元中的AlphaBlend函数。像这样可以产生半透明文本(带有阴影 - 建立在Jim McKeeth的响应之上),覆盖在图像上:

  
uses Windows, Graphics;
.
.
.
var
  BackgroundImage: Graphics.TBitmap; { need to call out specifically for Graphics.TBitmap
                                       because the Windows unit also has a TBitmap
                                       declaration }
  TextImage: Graphics.TBitmap;
  BlendFunc: BLENDFUNCTION;
begin
  BlendFunc.BlendOp := AC_SRC_OVER;
  BlendFunc.BlendFlags := 0;
  BlendFunc.SourceConstantAlpha := $C0; { a hex value from $00-$FF (0-255).
                                          Represents the percent of opaqueness:
                                          $00 is completely transparent, 
                                          $FF is completely opaque.
                                          $C0 is 75% opaque }
  BlendFunc.AlphaFormat := AC_SRC_ALPHA;

    { BackgroundImage is for holding the image you want to overlay text onto }
    BackgroundImage := Graphics.TBitmap.Create;
    try
      BackgroundImage.LoadFromFile('yourimagehere.bmp');

      { Create another TBitmap to hold the text you want to overlay }
      TextImage := Graphics.TBitmap.Create;
      try
        { Set this bitmap to have the same dimensions as the
          background image you want the text to appear on. }
        TextImage.Height := BackgroundImage.Height;
        TextImage.Width := BackgroundImage.Width;

        { In my limited experience with AlphaBlend, Black is always 100%
          transparent. So, paint TextImage completely Black. Play around
          with this to see the effect it has on the final outcome. }
        TextImage.Canvas.Brush.Color := clBlack;
        TextImage.Canvas.FloodFill(0, 0, clNone, fsBorder);

        TextImage.Canvas.Font.Style := [fsBold];

        { Write the shadow first }
        TextImage.Canvas.Brush.Style := bsClear;
        TextImage.Canvas.Font.Color  := clDkGray;
        TextImage.Canvas.TextOut(11, 11, 'Test');

        { Then put the text on top (slightly offset) }
        TextImage.Canvas.Brush.Style := bsClear;
        TextImage.Canvas.Font.Color  := clMaroon;
        TextImage.Canvas.TextOut(10, 10, 'Test');

        { Use the AlphaBlend function to overlay the bitmap holding the text
          on top of the bitmap holding the original image. }
        Windows.AlphaBlend(BackgroundImage.Canvas.Handle, 0, 0,
                           TextImage.Width, TextImage.Height,
                           TextImage.Canvas.Handle, 0, 0, TextImage.Width,
                           TextImage.Height, BlendFunc);

        { Assign the now updated BackgroundImage to a TImage control for display }  
        Image1.Picture.Bitmap.Assign(BackgroundImage);
      finally
        TextImage.Free;
      end;
    finally
      BackgroundImage.Free;
    end;
  end;

4

我猜测你想要实现的不仅仅是在透明背景上写入文本,而是希望在图像上写入某种形式的 alpha-blended 文本。
最简单的方法是利用 GDI+ 函数。它们已经被封装在 Delphi 中,并可以从 http://www.progdigy.com/ 下载。那里有许多示例可供参考。


Progdigy.com挂了吗?我无法访问它。 - Gabriel
似乎Delphi的GDI plus开发者和Embarcadero之间存在一些分歧,我不知道是否已经因此被撤回。您可以尝试搜索一些替代方案,例如Erik Van Bilsen的GDI plus - Anya Shenanigans

3
阴影很容易:
// Bold shows up better when over an image
image1.Canvas.Font.Style := [fsBold]; 
// Write the shadow first
image1.Canvas.Brush.Style:=bsClear;
image1.Canvas.Font.Color := clGrayText;
image1.Canvas.TextOut(1, 1, 'hi there');
// Then put the text on top (slightly offset)
image1.Canvas.Brush.Style:=bsClear;
image1.Canvas.Font.Color :=clBlack;
image1.Canvas.TextOut(0, 0, 'hi there');

这是一个具有透明背景的文本。或者你想让文本本身半透明?这有点棘手。您需要手动绘制它。相反,一个简单的方法是采样图像上写作区域的颜色平均值。然后将字体颜色设置为稍微浅一些,阴影设置为稍微深一些。然后它就会有点融合在一起。


Jim,我想要带有阴影或半透明的透明文本,而不是透明背景。 - Mohammed Nasman

2
我还没有测试过,但这会给你一些想法去哪里。关键是刷子的样式。
类似于这样:
img.Canvas.Brush.Style:=bsClear;
img.Canvas.Font.Color:=clBlack;
img.Canvas.TextOut(0, 0, 'hi there');

X-Ray,这将会用黑色写出文本,我希望文本是半透明或透明的,并带有阴影。 - Mohammed Nasman
字体颜色被使用,而不是笔的颜色。 - Jim McKeeth
字体颜色被使用,而不是笔的颜色。感谢你的更正,Jim。 - X-Ray
将画笔设置为bsClear并不会真正地使其透明,它使用画笔颜色作为背景颜色。如果您的背景是纯色的,则bsClear可以正常工作,但如果不是,则会失败。如果您想要文本具有真正的透明背景,则应使用:SetBkMode(Canvas.Handle,TRANSPARENT);并确保在设置Canvas.Brush.Color之后调用SetBkMode。 - Ben C

2

这个函数基于Dave Elsberry的思路。

与原版不同之处:

  • 只透明地绘制阴影
  • 使用了近2倍少的RAM
  • 参数

{-------------------------------------------------------------------------------------------------------------
  DrawTextShadowBox
    Draws text in a semi-transparent rectangle with shadow text.
    The shadow text is blended to the background and then blurred.

  Variant:
     1: Draws text in a box that is as wide as the BMP and can be aligned to top or bottom
     2: Draws text in a box that is as wide as text and is placed into the image at coordinates x,y

  Parameters:
     Opacity a value from 0-255. 0 => Shadow is completelly transparent
     To set the Font color/size, the caller should do: aCanvas.Font.Size:= x

  Issues:
     The blurring function cuts too suddenly. The rectangle that was blurred is too visible. Do a blur that slowly fades at the edges.
     Might be slow becuase of the alpha blending and because of the blur.

 Important!
     The input img must be pf24bit.
     When the AlphaFormat member is AC_SRC_ALPHA, the source bitmap must be 32 bpp. If it is not, the AlphaBlend function will fail.
-------------------------------------------------------------------------------------------------------------}
procedure DrawTextShadowBox(BMP: TBitmap; CONST Text: string; AlignTop: Boolean; ShadowColor: TColor= clTextShadow; ShadowOpacity: Byte= 20; Blur: Byte= 2);
VAR
   Shadow: Vcl.Graphics.TBitmap;
   BlendFunc: BLENDFUNCTION;
   x, y: Integer;
   BmpRect: TRect; { Rectangle in the original bitmap where we want to draw the shadowed text }
   ShadowRect: TRect;
   TextWidth, TextHeight: Integer;
   OriginalColor: TColor;
begin
  Assert(BMP.PixelFormat= pf24bit, 'Wrong pixel format!!');
  OriginalColor:= bmp.Canvas.Font.Color;
  TextWidth := BMP.Canvas.TextWidth (Text);
  TextHeight:= BMP.Canvas.TextHeight(Text);

  { Write the shadow on a separate bitmap (overlay) }
  Shadow := TBitmap.Create;
  TRY
    { Bitmap setup }
    Shadow.Canvas.Font.Assign(BMP.Canvas.Font);
    Shadow.PixelFormat:= pf24bit;
    Shadow.SetSize(BMP.Width, TextHeight);

    { Bitmap rectangle as big as ShadowBMP }
    ShadowRect.Left:= 0;
    ShadowRect.Top := 0;
    ShadowRect.Right := Shadow.Width;
    ShadowRect.Bottom:= Shadow.Height;

    { Fill shadow rectangle }
    Shadow.Canvas.Brush.Color := clBlack;                                        { In AlphaBlend, Black is always 100% transparent. So, paint Shadow completely Black. }
    Shadow.Canvas.FillRect(ShadowRect);

    BmpRect.Left  := 0;
    BmpRect.Right := Shadow.Width;
    if AlignTop
    then BmpRect.Top := 0
    else BmpRect.Top := BMP.Height- TextHeight;
    BmpRect.Bottom:= BmpRect.Top+ TextHeight;

    { Blend rectangle with orig image }                                          { Use the AlphaBlend function to overlay the bitmap holding the text on top of the bitmap holding the original image. }
    BlendFunc.BlendOp    := AC_SRC_OVER;
    BlendFunc.BlendFlags := 0;
    BlendFunc.SourceConstantAlpha := ShadowOpacity;
    BlendFunc.AlphaFormat         := 0;                                          //AC_SRC_ALPHA; //  if I put this back, the shadow will be completly invisible when merged with a white source image
    WinApi.Windows.AlphaBlend(BMP.Canvas.Handle, BmpRect.Left, BmpRect.Top, BmpRect.Right, TextHeight, Shadow.Canvas.Handle, 0, 0, Shadow.Width, Shadow.Height, BlendFunc);

    { Copy the blended area back to the Shadow bmp }
    Shadow.Canvas.CopyRect(ShadowRect, BMP.Canvas, BmpRect);

    { Diagonal shadow }
    x:= (BMP.Width  - TextWidth) DIV 2;   // Find center
    Shadow.Canvas.Brush.Style:= bsClear;
    Shadow.Canvas.Font.Color := ShadowColor;
    Shadow.Canvas.TextOut(x, 0, Text);

    { Blur the shadow }
    janFX.GaussianBlur(Shadow, Blur, 1);

    { Paste it back }
    BMP.Canvas.CopyRect(BmpRect, Shadow.Canvas, ShadowRect);
  FINALLY
    FreeAndNil(Shadow);
  END;

  { Draw actual text at 100% opacity }
  if AlignTop
  then y := 0
  else y := BMP.Height- TextHeight;
  BMP.Canvas.Brush.Style:= bsClear;
  BMP.Canvas.Font.Color := OriginalColor;
  BMP.Canvas.TextOut(x, y, Text);
end;



procedure DrawTextShadowBox(aCanvas: TCanvas; CONST Text: string;  X, Y: Integer; ShadowColor: TColor= clTextShadow; ShadowOpacity: Byte= 20; Blur: Byte= 2);
VAR
   Shadow: Vcl.Graphics.TBitmap;
   BlendFunc: BLENDFUNCTION;
   H, W: Integer;
   OriginalColor: TColor;
   R, R2: TRect;
CONST Edge= 5;
begin
 OriginalColor:= aCanvas.Font.Color;

 { Write the shadow on a separate bitmap (overlay) }
 Shadow := TBitmap.Create;
 TRY
   { Assign font }
   Shadow.Canvas.Font.Assign(aCanvas.Font);
   Shadow.PixelFormat:= pf24bit;

   { Compute overlay size }
   W:= Shadow.Canvas.TextWidth (Text);
   H:= Shadow.Canvas.TextHeight(Text);
   Shadow.SetSize(W, H);

   { Fill shadow rectangle }
   R:= Rect(0, 0, Shadow.Width, Shadow.Height);
   Shadow.Canvas.Brush.Color := clBlack;                               { In AlphaBlend, Black is always 100% transparent. So, paint Shadow completely Black. }
   Shadow.Canvas.FillRect(R);

   { Blend rectangle with orig image }                                 { Use the AlphaBlend function to overlay the bitmap holding the text on top of the bitmap holding the original image. }
   BlendFunc.BlendOp := AC_SRC_OVER;
   BlendFunc.BlendFlags := 0;
   BlendFunc.SourceConstantAlpha := ShadowOpacity;
   BlendFunc.AlphaFormat := 0;                                         //AC_SRC_ALPHA; //  if I put this back, the shadow will be completly invisible when merged with a white source image
   WinApi.Windows.AlphaBlend(aCanvas.Handle, x, y, Shadow.Width, Shadow.Height, Shadow.Canvas.Handle, 0, 0, Shadow.Width, Shadow.Height, BlendFunc);

   { Copy the blended area back to the Shadow bmp }
   R2:= rect(x, y, x+Shadow.Width, y+Shadow.Height);
   Shadow.Canvas.CopyRect(R, aCanvas, R2);

   { Diagonal shadow }
   Shadow.Canvas.Brush.Style:= bsClear;
   Shadow.Canvas.Font.Color := ShadowColor;
   Shadow.Canvas.TextOut(0, 0, Text);

   { Blur the shadow }
   janFX.GaussianBlur(Shadow, blur, 1);

   { Paste it back }
   aCanvas.CopyRect(R2, Shadow.Canvas, R);
 FINALLY
   FreeAndNil(Shadow);
 END;

 { Draw actual text at 100% opacity }
 aCanvas.Brush.Style:= bsClear;
 aCanvas.Font.Color := OriginalColor;
 aCanvas.TextOut(x, y, Text);
end;


procedure TfrmTest.UseIt;
VAR BackgroundImage: tbitmap;
begin
 BackgroundImage := Graphics.TBitmap.Create;   
 try
   BackgroundImage.LoadFromFile('c:\test.bmp');
   DrawShadowText (BackgroundImage.Canvas, 'This is some demo text', 20, 40, 140, clRed, clSilver);
   Image1.Picture.Bitmap.Assign(BackgroundImage);
 FINALLY
   BackgroundImage.Free;
 end;
end;

嗨Z80,我修改了这个例程以获取我正在叠加文本的图像的宽度和高度,那将是6000 x 4000,因此创建的Tmp文本图像具有相同的尺寸加上200的字体大小,但无论我改变什么都无法获得任何类型的阴影指示。你能帮忙吗? - Jerry Mallett
在之前和之后,我再次修改了代码以获取阴影。 - Jerry Mallett
更新的代码。他们需要JanFX库(免费)来使图像模糊。如果您不想安装它,只需忽略对该库的调用即可。代码可以改进,但它现在已经是功能性的。 - Gabriel

1
你可以使用bitblt例程将图像合并到公共画布上,然后再保存图像。

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接