我需要使用 GDI+ 淡化图像的右侧。我实际上是在尝试模拟您在 Google Chrome 中看到的右侧文本淡入淡出。这就是我想做的事情。
【问题讨论】：
标签： delphi gdi+ delphi-xe2 gdi
您不需要转换这些 - 至少如果您使用 Delphi2010+.... TBitmap（分别为 TGraphic）已经有一种方法可以使用不透明度参数在画布上绘制位图 - 看看delphi帮助中的DrawTransparent方法即可。
如果这还不够，请查看 windows gdi api 中的 AlphaBlend 函数。
为了使整个过程顺利进行，我认为您应该：
如果您仍然遇到一些闪烁，那么最终启用双缓冲和/或自己处理 WM_ERASEBKNG 消息。
【讨论】：
如果你真的想为此使用 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
【讨论】：
没有 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.
【讨论】：