1

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

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

3 回答 3

4

如果你真的想为此使用 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 演示

于 2012-12-04T14:18:02.080 回答
1

可以通过这种方式完成另一种没有 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.

演示

于 2012-12-04T15:18:13.417 回答
0

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

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

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

  • 创建带背景的位图
  • 使用文本创建位图
  • 在计时器过程（可能触发淡入淡出无效）中设置不透明度值并仅为该特定区域触发无效（invalidateRect）
  • 在绘画过程中创建第三个位图-> 绘制背景，然后使用 alpha 值在其上设置文本（或任何位图）。
  • 在画布上绘制生成的位图。

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

于 2012-12-04T14:09:01.007 回答