delphi - 使用 GDI+ 淡入淡出图像(即仅更改 TGPGraphic 的 Alpha channel )

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