使用GDI +淡入图像（即仅更改TGPGraphic的Alpha通道）

Question

我需要使用GDI +淡入图像的右侧。 我实际上是在尝试模仿您在Google Chrome浏览器中看到的右侧文本淡入淡出。 这就是我想要做的。

• 从TBitmap创建一个TGPGraphics对象。
• 从TBitmap的区域创建一个TGPBitmap 。
• 将TGPGraphics对象的背景和文本绘制到TGPBitmap 。
• 更改TGPBitmap对象右侧的Alpha设置以产生淡入淡出效果。
• 将TGPBitmap绘制回TGPGraphics对象。

Answer 1

如果您真的想为此使用GDI +

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg;

type
  TForm3 = class(TForm)
    PaintBox1: TPaintBox;
    Image1: TImage;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Timer1: TTimer;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

uses
  EXGDIPAPI,
  EXGDIPOBJ;

{$R *.dfm}

Procedure GPEasyTextout(Graphics: TGPGraphics; Const TheText: String; Rect: TGPRectF; Color: TGPColor; HAlign, VAlign: TStringAlignment; Size: Integer = 10;
  FontName: String = 'Arial');
var
  StringFormat: TGPStringFormat;
  FontFamily: TGPFontFamily;
  Font: TGPFont;
  Pen: TGPPen;
  Brush: TGPSolidBrush;
begin
  StringFormat := TGPStringFormat.Create;
  FontFamily := TGPFontFamily.Create(FontName);
  Font := TGPFont.Create(FontFamily, Size, FontStyleRegular, UnitPixel);
  Pen := TGPPen.Create(Color);
  Brush := TGPSolidBrush.Create(Color);
  StringFormat.SetAlignment(HAlign);
  StringFormat.SetLineAlignment(VAlign);
  Graphics.DrawString(TheText, -1, Font, Rect, StringFormat, Brush);
  Pen.Free;
  Brush.Free;
  StringFormat.Free;
  FontFamily.Free;
  Font.Free;
end;

Procedure PaintImageTransparent(DC: HDC; AGraphic: TGraphic;AlphaDec:Byte);

var
  Graphics, bmpgraphics: TGPGraphics;
  Width, Height, Row, Column: Integer;
  Color, colorTemp: TGPColor;
  bitmap, BitmapOut: TGPBitmap;
  Stream: TMemoryStream;
  Alpha:Integer;
begin
  Graphics := TGPGraphics.Create(DC);  // destination
  Stream := TMemoryStream.Create;      // Stremm to keep normal TGraphic
  AGraphic.SaveToStream(Stream);
  bitmap := TGPBitmap.Create(TStreamAdapter.Create(Stream));
  bmpgraphics := TGPGraphics.Create(bitmap); // Graphic for Bitmap
  GPEasyTextout(bmpgraphics, 'Some Text to display', MakeRect(10.0, 10, 300, 200), MakeColor(0, 0, 0), StringAlignmentCenter, StringAlignmentCenter, 20);
  bmpgraphics.Free;
  Width := bitmap.GetWidth;
  Height := bitmap.GetHeight;

  BitmapOut := TGPBitmap.Create(Width, Height); // Outputbitmap
  bmpgraphics := TGPGraphics.Create(BitmapOut); // Graphic for Bitmap
  bmpgraphics.DrawImage(bitmap, 0, 0, Width, Height);
  bmpgraphics.Free;

  for Row := 0 to Height - 1 do
  begin
    for Column := 0 to Width - 1 do
    begin
      BitmapOut.GetPixel(Column, Row, Color);
      Alpha := ((255 * (Width - Column)) div Width) + AlphaDec;
      if Alpha>255 then Alpha := 255;

      colorTemp := MakeColor(Alpha, GetRed(Color), GetGreen(Color), GetBlue(Color));
      BitmapOut.SetPixel(Column, Row, colorTemp);
    end;
  end;

  Graphics.DrawImage(BitmapOut, 0, 0, Width, Height);

  BitmapOut.Free;
  bitmap.Free;
  Graphics.Free;
  Stream.Free;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
   ReportMemoryLeaksOnShutDown := True;
end;

procedure TForm3.PaintBox1Paint(Sender: TObject);
begin
  PaintImageTransparent(TPaintBox(Sender).Canvas.Handle, Image1.picture.Graphic,Timer1.Tag);
end;

procedure TForm3.Timer1Timer(Sender: TObject);
begin
  Timer1.Tag := Timer1.Tag + 10;
  if Timer1.Tag>255 then
    begin
     Timer1.Tag := 255;
     Timer1.Enabled := false;
    end
  else PaintBox1.Invalidate;

end;

end.

完整的资源在这里http://www.bummisoft.de/download/transparentverlauf.zip

Answer 2

没有GDI +的另一种方法可以通过这种方式完成。 -为透明度创建和准备位图-在其上绘制-设置透明度渐变-绘制它

unit Unit3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, jpeg;

type
  TForm3 = class(TForm)
    Image1: TImage;
    PaintBox1: TPaintBox;
    Timer1: TTimer;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private

    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form3: TForm3;

implementation

{$R *.dfm}
procedure TForm3.FormCreate(Sender: TObject);
begin
  DoubleBuffered := true;
end;

type
  pRGBQuadArray = ^TRGBQuadArray;
  TRGBQuadArray = ARRAY [0 .. $EFFFFFF] OF TRGBQuad;

Procedure SetAlpha(bmp: TBitMap; Alpha: Byte);
var
  pscanLine32: pRGBQuadArray;
  i, j: Integer;
  lAlpha:Integer;
begin

  for i := 0 to bmp.Height - 1 do
  begin
    pscanLine32 := bmp.Scanline[i];
    for j := 0 to bmp.Width - 1 do
      begin
        lAlpha := Round(255 * (bmp.width- j) / bmp.width )+ Alpha;
        if lAlpha>255 then lAlpha := 255;
        pscanLine32[j].rgbReserved := lAlpha;
        pscanLine32[j].rgbBlue := Round(pscanLine32[j].rgbBlue * lAlpha / 255);
        pscanLine32[j].rgbRed :=  Round(pscanLine32[j].rgbRed * lAlpha / 255);
        pscanLine32[j].rgbGreen :=  Round(pscanLine32[j].rgbGreen * lAlpha / 255);
      end;
  end;

end;

Procedure InitAlpha(bmp: TBitMap);
var
  pscanLine32: pRGBQuadArray;
  i, j: Integer;
  lAlpha:Integer;
begin
 bmp.PixelFormat := pf32Bit;
 bmp.HandleType := bmDIB;
 bmp.ignorepalette := true;
 bmp.alphaformat := afDefined;
  for i := 0 to bmp.Height - 1 do
  begin
    pscanLine32 := bmp.Scanline[i];
    for j := 0 to bmp.Width - 1 do
      begin
        pscanLine32[j].rgbReserved := 255;
        pscanLine32[j].rgbBlue := 0;
        pscanLine32[j].rgbRed := 0;
        pscanLine32[j].rgbGreen := 0;
      end;
  end;

end;




procedure TForm3.PaintBox1Paint(Sender: TObject);
var
 bmp:TBitmap;
begin
    bmp:=TBitmap.Create;
    try

      bmp.Width := Image1.Picture.Graphic.Width;
      bmp.Height := Image1.Picture.Graphic.Height;
      InitAlpha(bmp);
      bmp.Canvas.Draw(0,0,Image1.Picture.Graphic);
      bmp.Canvas.Brush.Style := bsClear;
      bmp.Canvas.Font.Size := 20;
      bmp.Canvas.TextOut(10,10,'Some tex to display');
      SetAlpha(bmp,Timer1.tag);
      TPaintBox(Sender).Canvas.Draw(0,0,bmp);
    finally
      bmp.Free;
    end;
end;

procedure TForm3.Timer1Timer(Sender: TObject);
begin
  Timer1.Tag :=  Timer1.Tag + 10;
  if Timer1.Tag>255 then
    begin
       Timer1.Tag:=255;
       Timer1.Enabled := False;
    end
   else Paintbox1.Invalidate;
end;

end.

Answer 3

您不需要转换它们-至少如果您使用Delphi2010 +...。TBitmap（分别为TGraphic）已经具有在具有不透明度参数的画布上绘制位图的方法-只需查看delphi帮助中的DrawTransparent方法即可。

如果这还不够，请从Windows gdi api中检出AlphaBlend函数。

为了使整个过程顺利进行，我认为您应该：

• 用背景创建位图
• 用文本创建位图
• 在计时器过程中（可能触发衰落无效）设置不透明度值，并仅针对该特定区域触发无效（invalidateRect）
• 在绘制过程中，创建第三个位图->绘制背景，然后使用alpha值设置文本（或其他位图）。
• 在画布上绘制结果位图。

如果仍然遇到闪烁，请最终启用双重缓冲和/或自行处理WM_ERASEBKNG消息。