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 Demo

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.

Demo

Answer 3

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

如果这还不够，请从windows gdi api中查看AlphaBlend函数。

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

使用背景创建位图
使用文字
在计时器程序中（可能触发衰落无效）设置不透明度值并仅触发该特定区域的无效值（invalidateRect）
在绘画程序中创建第三个位图 - ＆gt;画背景然后用 alpha值设置文本（或任何位图）。
在画布上绘制结果位图。

如果您仍然遇到一些闪烁，那么最终会启用双缓冲和/或自己处理WM_ERASEBKNG消息。

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

3 个答案: