Mega Code Archive
Transparent background image for formcontrolshintsetc
<![CDATA[
Title: Transparent background image for form/controls/hints/etc
Question: We always like great look, whether for ourselves or for our apps. How bout we get the screen image and make it looks like transparent, and make that our form's backgound?
Answer:
This is a component to grab screen's display. Then produce a transparent-look-alike bitmap of any given rectangle.Put the bitmap as our form's background, it'll looks like it's tranparent.
I created a transparent hint window using this component. I'll post the transparent hint code later. Code here contains some portion I gather from the newsgroup.
unit udcUtil;
interface
uses Windows, Graphics, Classes;
type
TTransparentBitmap = class(TObject)
protected
procedure NewBitmap;
procedure NewTransBitmap;
procedure FreeBitmap;
procedure FreeTransBitmap;
procedure GetScreenBitmap(r: TRect);
public
Bitmap: TBitmap;
TransBitmap: TBitmap;
procedure CreateBitmap(r: TRect; Color: TColor; Level: Integer); virtual;
procedure PrepareScreenBitmap(R: TRect); virtual;
procedure ApplyTransparency(r: TRect; Color: TColor; Level: Integer); virtual;
destructor Destroy; override;
end;
implementation
procedure TTransparentBitmap.ApplyTransparency(r: TRect; Color: TColor;
Level: Integer);
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..1000000] of TRGBTriple;
var
SL: PRGBArray;
X, Y: Integer;
aColor: Cardinal;
begin
NewTransBitmap;
TransBitmap.Width := r.Right-r.Left+1;
TransBitmap.Height := r.Bottom-r.Top+1;
BitBlt(TransBitmap.Canvas.Handle, r.Left, r.Top, r.Right, r.Bottom,
Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
aColor := ColorToRGB(Color);
for Y := 0 to TransBitmap.Height - 1 do begin
SL := TransBitmap.ScanLine[Y];
for X := 0 to TransBitmap.Width - 1 do
try
SL[X].rgbtRed := (Level * SL[X].rgbtRed + (100 -
Level) * GetRValue(aColor)) div 100;
SL[X].rgbtGreen := (Level * SL[X].rgbtGreen + (100 -
Level)* GetGValue(aColor)) div 100;
SL[X].rgbtBlue := (Level * SL[X].rgbtBlue + (100 -
Level) * GetBValue(aColor)) div 100;
except
end;
end;
end;
procedure TTransparentBitmap.CreateBitmap(r: TRect; Color: TColor; Level: Integer);
begin
PrepareScreenBitmap(r);
ApplyTransparency(Rect(0,0, Bitmap.Width-1, Bitmap.Height-1), Color, Level);
end;
destructor TTransparentBitmap.Destroy;
begin
FreeBitmap;
FreeTransBitmap;
inherited;
end;
procedure TTransparentBitmap.FreeBitmap;
begin
Bitmap.Free;
end;
procedure TTransparentBitmap.FreeTransBitmap;
begin
TransBitmap.Free;
end;
procedure TTransparentBitmap.GetScreenBitmap(r: TRect);
var DC: HDC;
begin
Bitmap.Width := r.Right-r.Left+1;
Bitmap.Height := r.Bottom-r.Top+1;
DC := GetDC(0);
try
with Bitmap do
BitBlt(Canvas.Handle, 0, 0,
Width, Height, DC, r.Left, r.Top, SrcCopy);
finally
ReleaseDC(0, DC);
end;
end;
procedure TTransparentBitmap.NewBitmap;
begin
FreeBitmap;
Bitmap := TBitmap.Create;
Bitmap.PixelFormat := pf24bit;
end;
procedure TTransparentBitmap.NewTransBitmap;
begin
FreeTransBitmap;
TransBitmap := TBitmap.Create;
TransBitmap.PixelFormat := pf24bit;
end;
procedure TTransparentBitmap.PrepareScreenBitmap(r: TRect);
begin
NewBitmap;
GetScreenBitmap(R);
end;
end.
Usage:
var FTransBitmap: TTransparentBitmap;
FTransBitmap.CreateBitmap(Rect, clYellow, 50);
// Create a transparent bitmap from desktop, rect is the boundary,
// We used a yellow layer here, with 50% transparency
// To show the bitmap just use:
BitBlt(Canvas.Handle, 0, 0, FTransBitmap.TransBitmap.Width, FTransBitmap.TransBitmap.Height,
FTransBitmap.TransBitmap.Canvas.Handle, 0, 0, SRCCOPY);
]]>