另外一个关于透明的贴子

I

import

Unregistered / Unconfirmed
GUEST, unregistred user!
My about box is transparent. You can change from here. It's not the best way, but works fine.
ABOUTBOX FORM
-insert a TImage with AllClient called img.
MAIN FORM
procedure CallAboutBox;
var
screenshoot: TBitmap;
begin
screenshoot := TBitmap.Create;
fAbout := TfAbout.create(self);
DrawBack;
fAbout.show;
screenshoot.free;
end;
procedure DrawBack;
type
PRGBArray = ^TRGBArray;
TRGBArray = array[0..1000000] of TRGBTriple;
var
DC: hDC;
ScreenWidth, ScreenHeight: Integer;
SL: PRGBArray;
X, Y: Integer;
const
FTransparency = 30; // % of transparency
FTranspColor = clGray; // color to be merged
begin
ScreenWidth := GetSystemMetrics(sm_CXScreen);
ScreenHeight := GetSystemMetrics(sm_CYScreen);
ScreenShoot.Width := ScreenWidth;
ScreenShoot.Height := ScreenHeight;
ScreenShoot.PixelFormat := pf24bit;
// get screen image
DC := GetDC(0);
BitBlt(ScreenShoot.Canvas.Handle, 0, 0,
ScreenWidth, ScreenHeight, DC, 0, 0, SrcCopy);
ReleaseDC(0, DC);
for Y := 0 to ScreenHeight - 1 do begin
SL := ScreenShoot.ScanLine[Y];
for X := 0 to ScreenWidth - 1 do
try
SL[X].rgbtRed := (FTransparency * SL[X].rgbtRed + (100 -
FTransparency) * GetRValue(FTranspColor)) div 100;
SL[X].rgbtGreen := (FTransparency * SL[X].rgbtGreen + (100 -
FTransparency)* GetGValue(FTranspColor)) div 100;
SL[X].rgbtBlue := (FTransparency * SL[X].rgbtBlue + (100 -
FTransparency) * GetBValue(FTranspColor)) div 100;
except
end;
end;
with fAbout do begin
X := ((ScreenWidth - width) div 2) + img.Left;
Y := ((Screenheight - height) div 2) + img.Top;
if WindowState = wsNormal then
case BorderStyle of
bsSingle,
bsDialog: begin
inc(X, GetSystemMetrics(sm_CXDlgFrame));
inc(Y, GetSystemMetrics(sm_CYDlgFrame));
end;
bsSizeable: begin
inc(X, GetSystemMetrics(sm_CXFrame));
inc(Y, GetSystemMetrics(sm_CYFrame));
end;
bsToolWindow,
bsSizeToolWin: begin
inc(X, GetSystemMetrics(sm_CXBorder));
inc(Y, GetSystemMetrics(sm_CYBorder));
end;
end;
if BorderStyle <> bsNone then
inc(Y, GetSystemMetrics(sm_CYCaption));
BitBlt(img.Canvas.Handle, 0, 0, img.Width, img.Height,
ScreenShoot.Canvas.Handle, x, y, SrcCopy);
end;
end;
 
 

Similar threads

I
回复
0
查看
521
import
I
I
回复
0
查看
602
import
I
I
回复
0
查看
558
import
I
顶部