Fade out the image with GDI + (i.e. change only the alpha channel of the TGPGraphic)
I need to stroke the right side of an image using GDI +. I'm actually trying to mimic the right side textures you see in Google Chrome. This is what I want to do.
- Create a TGPGraphics object from TBitmap .
- Create a TGPBitmap from the TBitmap area .
- Draw the background of the TGPGraphics object and the TGPBitmap text .
- Change the Alpha settings on the right side of the TGPBitmap to create a fading effect.
- Return TGPBitmap back object TGPGraphics .
+1
source to share
3 answers
If you really want to use GDI + for this
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.
full source available http://www.bummisoft.de/download/transparentverlauf.zip
+4
source to share
Another approach without GDI + could be done this way. -Create and prepare a bitmap for transparency -paint on it a transparency gradient -set -paint it
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.
+1
source to share
You don't need to convert them - at least if you are using Delphi2010 + .... TBitmap (TGraphic respectively) already has a way to draw a bitmap to canvas with an opacity parameter - Just look at the DrawTransparent method in the delphi help.
If that's not enough, check the AlphaBlend function from the gdi api windows.
To make this procedure smooth, I think you should:
- create bitmap with background
- create bitmap with text
- in a timer routine (which can invalidate the fade out) sets the opacity value and triggers invaldiate only for a specific scope (invalidateRect)
- in the drawing routine, create a third bitmap -> draw a border and then with the alpha value sets the text (or any bitmap) up.
- draw the resulting bitmap onto the canvas.
if you are still experiencing some flickering and then enable double buffering and / or handle the WM_ERASEBKNG message yourself.
0
source to share