半透明窗体的实现(50分)

请问怎样实现像QQ、千千静听那样的半透明窗体[]

TFrom.AlphaBlend:=True
AlphaBlendValue:=xxxx;

好像只支持2k，xp等。9x下要用api哦，自己查吧。

有一些控件很方便的就能实现呀.自己去盒子里面找一下吧.

TFrom.AlphaBlend:=True
AlphaBlendValue:=xxxx;

好像只支持2k，xp等。9x下要用api哦，自己查吧。
1ST..控件里面好像有这么一个控件

代码片断，在TForm.Create中加入
其中$AA0000的值可以根据需要自行调节，可以实现不同透明的窗体。handle－窗体.handle
i:=getWindowLong(Handle, GWL_EXSTYLE);
i := i Or $AA0000;
SetWindowLong (handle, GWL_EXSTYLE, i);
SetLayeredWindowAttributes(handle, 0, 180, 2);

TFrom.AlphaBlend:=True
AlphaBlendValue:=xxxx;
只支持2k，xp等。9x下要用api

9x用api也没用，因为SetLayeredWindowAttributes是2K才开始有的

查看
http://www.qostudy.org/pr/Article/aspnet/Delphi/200606/34549.html

那请问在98下怎样实现那??

TFrom.AlphaBlend:=True
AlphaBlendValue:=xxxx;

好像只支持2k，xp等

98下好像没有看过实现的吧

问题: 请教如何制作半透明窗体？ ( 积分: 100 )
分类: 图形图象

来自: yanyandt2, 时间: 2003-03-06 9:49:00, ID: 1659077
不用win2000新提供的API
用win98下能运行的。
谢谢！

来自: c2008, 时间: 2003-03-06 9:50:00, ID: 1659088
邮件地址我给你一个

来自: yanyandt2, 时间: 2003-03-06 9:54:00, ID: 1659106
realyanyan@21cn.com
谢谢
收到就结束问题

来自: Solid_Snake, 时间: 2003-03-06 9:57:00, ID: 1659124
procedure TForm1.FormCreate(Sender: TObject);
begin
form1.brush.style:= bsclear;
form1.borderstyle:= bsnone;
end;
如果是你想要的结果，给我点分吧，很穷的，如果不是也没关系，赫赫。

来自: goddy, 时间: 2003-03-06 10:00:00, ID: 1659140
好像那個影霸做得很好

来自: yanyandt2, 时间: 2003-03-06 10:01:00, ID: 1659142
Solid_Snake
你说的透明窗体，我说的是半透明窗体
抱歉，不能给你分了

来自: yanyandt2, 时间: 2003-03-06 10:02:00, ID: 1659149
c2008
我等到花儿也谢了~~~~~~~~~~

来自: michael.fly, 时间: 2003-03-06 10:18:00, ID: 1659215
从DELPHI6开始,TFORM提供了两个属性:ALPHABLEND,和ALPHABLENDVALUE,要实现半透明,只要将
ALPHABLEND设为TRUE,然后设置ALPHABLENDVALUE的值就可以了.

来自: DEN, 时间: 2003-03-06 10:18:00, ID: 1659216
给你发了邮件,看看能行吧.

来自: 雨人, 时间: 2003-03-06 10:19:00, ID: 1659220
delphi6中Form本来就提供该属性，你在属性里找一下！

来自: 康凌, 时间: 2003-03-06 10:19:00, ID: 1659221
D6可以直接做出呀！
设置AlphaBlend属性呀！

来自: DEN, 时间: 2003-03-06 10:19:00, ID: 1659222
不过只能在2K,NT,XP下运行成功的.

来自: yanyandt2, 时间: 2003-03-06 10:21:00, ID: 1659236
michael.fly
你太帅了！！

DEN,邮件没收到。。。。

来自: yanyandt2, 时间: 2003-03-06 10:24:00, ID: 1659238
michael.fly
你说的那个方法编译后，在98下也没问题吧？

来自: 墙头草, 时间: 2003-03-06 10:24:00, ID: 1659239
纯代码实现你看看
在windows2000下增加了一些API,可以轻易的实现半透明的窗体，源程序如下，必要的地方我加上了注释

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const

WS_EX_LAYERED = $80000;

AC_SRC_OVER = $0;

AC_SRC_ALPHA = $1;

AC_SRC_NO_PREMULT_ALPHA = $1;

AC_SRC_NO_ALPHA = $2;

AC_DST_NO_PREMULT_ALPHA = $10;

AC_DST_NO_ALPHA = $20;

LWA_COLORKEY = $1;

LWA_ALPHA = $2;

ULW_COLORKEY = $1

ULW_ALPHA = $2

ULW_OPAQUE = $4

//新增加的常量定义

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函数声明

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var l:longint;

begin

l:=getWindowLong(Handle, GWL_EXSTYLE);

l := l Or WS_EX_LAYERED;

SetWindowLong (handle, GWL_EXSTYLE, l);

SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);

//第二个参数是指定透明颜色

//第二个参数为0则使用第四个参数设置alpha值，从0到255，其他的我不太清楚，因为没有api帮助

end;







end.



来自: yanyandt2, 时间: 2003-03-06 10:26:00, ID: 1659245
墙头草
你的那个我找过了，只能 win2000以上才可以

来自: 陈晨, 时间: 2003-03-06 10:29:00, ID: 1659257
如何制作半透明窗口

---- 用过金山词霸的朋友，一定会为其半透明的翻译提示窗口而称奇。究竟这种窗口是如何做出来的呢？下面我们将来探讨这种半透明的窗口的制作方法。

一、 原理
---- 首先，我们先从透明窗口说起，其实透明窗口就是可以透过窗口看到它背景。所以，我们可以将窗口后面的背景图象，显示在窗口前面，就可实现透明窗口的效果了。至于半透明的效果，是在透明的基础上，加上一层滤镜，使看到的背景模糊一点而已。所以，在拿到背景图象后，先在该图象加上一层滤镜（把图象弄模糊），然后再显示在窗口上，就能达到半透明的效果。
---- 我们可归纳出实现半透明窗口的步骤：在窗口显示前其获取背景图 → 对背景图象进行滤镜效果处理 → 将处理过的背景图象显示在窗口前面。

---- （1） 获取背景图象

---- 要获取背景图，先用GetDC(0)函数获取整个屏幕设备场景（DC），再用CopyRect函数拷贝窗口的背景到指定的Tbitmap，该Tbitmap就是我们所要的图象了。其中函数GetDC(0)取得的DC可用TCanvas.Handle保存；而CopyRect是TCancas类的成员函数，作用是从一Canvas中拷贝一指定区域（Rect）到另一Canvas的指定区域。

---- (2）对背景图进行滤镜效果处理

---- 用循环的方法遍历图象的每一点，将各点的某些频段的光波滤除。其实，滤镜种类繁多，所以的算法亦很多，读者们可参考相关资料，选择您满意的方法。本文的滤镜是灰色的，实现方法见TranslucentBmp(Bmp:TBitmap;AColor:TColor;ATransparent:Longint)。其中，参数Bmp是要处理的图象，AColor是滤镜的颜色，ATransparent是透明度。

二、 写程序
----
将以上原理用Delphi编写成程序，在Delphi中新建一Project，Form1的Height和Width分别设成150和300（不要做的太大，不然显示速度很慢），再设置BorderStyle的值为bsNone；在Form1中添加一Timage控件Image1，将其Align属性设成alClient。再添加一标签Label1和按钮TSpeedButton，在Label1的Caption属性中输入"这是一半透明窗口！"，按钮的Caption属性设成"x"，在其OnClick事件中输入一行"Close;"。并将它们Bring to Front。另外，可添加四个TShape，贴在Image1的四边上，以构造Form1的3D效果，如图（一）。各控件的属性如下表：

组件名称 属性 设置值
Form1 BorderStyle BsNone
Height 150
Width 300
TFont 宋体9号
Image1 Align AlClient
Label1 Caption 这是一半透明窗口！
TFont 宋体9号，黄色
SpeedButton1 Caption X
Left 279
Top -1
Height 14
Width 13
Transparent True



图（一）
---- 完整的源代码如下：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;

type
TForm1 = class(TForm)
Label1: TLabel;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
Image1: TImage;
SpeedButton1: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
//截获背景图象
function GetBackgroundBmp:TBitmap;
//对背景图象进行滤镜处理
procedure TranslucentBmp(Bmp:TBitmap;
AColor:TColor;ATransparent:Longint);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
//以下截获背景图象
function TForm1.GetBackgroundBmp:TBitmap;
var Scn:TCanvas;
h,w:Integer;
begin
Scn:=TCanvas.Create; //建立整个屏幕的画布
h:=ClientHeight;//窗口的高
w:=ClientWidth; //窗口的宽
Result.Height:=h; //设返回位图的高就是窗口的高
Result.Width:=w;//设返回位图的宽就是窗口的宽
try
Scn.Handle:=GetDC(0);//取得整个屏幕的DC
//以下一行将窗口的背景部分复制到指定的画布中，
也就是本函数的返回值
Result.Canvas.CopyRect(Rect(0,0,w,h),Scn,
Rect(Left,Top,Left+w,Top+h));
ReleaseDC(0, Scn.handle);
finally
Scn.Free;
end;
end;

//以下函数对背景图象进行滤镜处理，
Bmp是要处理的位图；ATransparent是透明度
procedure TForm1.TranslucentBmp(Bmp:
TBitmap;AColor:TColor;ATransparent:Longint);
var BkColor:COLORREF;
ForeColor:Longint;
R,G,B:Int64;
i,j:Integer;
begin
ForeColor:=ColorToRGB(AColor);
with Bmp.Canvas do
for i:=ClientHeight-1 downto 0 do
for j:=ClientWidth-1 downto 0 do
begin
BkColor:=GetPixel(Handle,j,i); //取得每一象素
R:=Byte(ForeColor)+
(Byte(BkColor)-Byte(ForeColor))*ATransparent;
G:=Byte(ForeColor shr 8)+
(Byte(BkColor shr 8)-Byte(ForeColor
shr 8))*ATransparent;
B:=Byte(ForeColor shr 16)+
(Byte(BkColor shr 16)-Byte(ForeColor
shr 16))*ATransparent;
SetPixelV(Han

来自: DEN, 时间: 2003-03-06 10:29:00, ID: 1659258
TransparenceForm(handle,200);其中的第二个参数可以调节的,你试试看.

来自: yanyandt2, 时间: 2003-03-06 10:31:00, ID: 1659263
接受答案
michael.fly
得到了大部分分数
谢谢各位

来自: Imfish, 时间: 2003-03-06 10:34:00, ID: 1659281
可以参考一下
如何制作半透明窗口
松本电工实业有限公司
舒嵩嵩
---- 用过金山词霸的朋友，一定会为其半透明的翻译提示窗口而称奇。究竟这种窗口是如何做出来的呢？下面我们将来探讨这种半透明的窗口的制作方法。

一、 原理
---- 首先，我们先从透明窗口说起，其实透明窗口就是可以透过窗口看到它背景。所以，我们可以将窗口后面的背景图象，显示在窗口前面，就可实现透明窗口的效果了。至于半透明的效果，是在透明的基础上，加上一层滤镜，使看到的背景模糊一点而已。所以，在拿到背景图象后，先在该图象加上一层滤镜（把图象弄模糊），然后再显示在窗口上，就能达到半透明的效果。
---- 我们可归纳出实现半透明窗口的步骤：在窗口显示前其获取背景图 → 对背景图象进行滤镜效果处理 → 将处理过的背景图象显示在窗口前面。

---- （1） 获取背景图象

---- 要获取背景图，先用GetDC(0)函数获取整个屏幕设备场景（DC），再用CopyRect函数拷贝窗口的背景到指定的Tbitmap，该Tbitmap就是我们所要的图象了。其中函数GetDC(0)取得的DC可用TCanvas.Handle保存；而CopyRect是TCancas类的成员函数，作用是从一Canvas中拷贝一指定区域（Rect）到另一Canvas的指定区域。

---- (2）对背景图进行滤镜效果处理

---- 用循环的方法遍历图象的每一点，将各点的某些频段的光波滤除。其实，滤镜种类繁多，所以的算法亦很多，读者们可参考相关资料，选择您满意的方法。本文的滤镜是灰色的，实现方法见TranslucentBmp(Bmp:TBitmap;AColor:TColor;ATransparent:Longint)。其中，参数Bmp是要处理的图象，AColor是滤镜的颜色，ATransparent是透明度。

二、 写程序
----
将以上原理用Delphi编写成程序，在Delphi中新建一Project，Form1的Height和Width分别设成150和300（不要做的太大，不然显示速度很慢），再设置BorderStyle的值为bsNone；在Form1中添加一Timage控件Image1，将其Align属性设成alClient。再添加一标签Label1和按钮TSpeedButton，在Label1的Caption属性中输入"这是一半透明窗口！"，按钮的Caption属性设成"x"，在其OnClick事件中输入一行"Close;"。并将它们Bring to Front。另外，可添加四个TShape，贴在Image1的四边上，以构造Form1的3D效果，如图（一）。各控件的属性如下表：

组件名称 属性 设置值
Form1 BorderStyle BsNone
Height 150
Width 300
TFont 宋体9号
Image1 Align AlClient
Label1 Caption 这是一半透明窗口！
TFont 宋体9号，黄色
SpeedButton1 Caption X
Left 279
Top -1
Height 14
Width 13
Transparent True



图（一）
---- 完整的源代码如下：

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes,
Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons;

type
TForm1 = class(TForm)
Label1: TLabel;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
Image1: TImage;
SpeedButton1: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
private
{ Private declarations }
//截获背景图象
function GetBackgroundBmp:TBitmap;
//对背景图象进行滤镜处理
procedure TranslucentBmp(Bmp:TBitmap;
AColor:TColor;ATransparent:Longint);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}
//以下截获背景图象
function TForm1.GetBackgroundBmp:TBitmap;
var Scn:TCanvas;
h,w:Integer;
begin
Scn:=TCanvas.Create; //建立整个屏幕的画布
h:=ClientHeight;//窗口的高
w:=ClientWidth; //窗口的宽
Result.Height:=h; //设返回位图的高就是窗口的高
Result.Width:=w;//设返回位图的宽就是窗口的宽
try
Scn.Handle:=GetDC(0);//取得整个屏幕的DC
//以下一行将窗口的背景部分复制到指定的画布中，
也就是本函数的返回值
Result.Canvas.CopyRect(Rect(0,0,w,h),Scn,
Rect(Left,Top,Left+w,Top+h));
ReleaseDC(0, Scn.handle);
finally
Scn.Free;
end;
end;

//以下函数对背景图象进行滤镜处理，
Bmp是要处理的位图；ATransparent是透明度
procedure TForm1.TranslucentBmp(Bmp:
TBitmap;AColor:TColor;ATransparent:Longint);
var BkColor:COLORREF;
ForeColor:Longint;
R,G,B:Int64;
i,j:Integer;
begin
ForeColor:=ColorToRGB(AColor);
with Bmp.Canvas do
for i:=ClientHeight-1 downto 0 do
for j:=ClientWidth-1 downto 0 do
begin
BkColor:=GetPixel(Handle,j,i); //取得每一象素
R:=Byte(ForeColor)+
(Byte(BkColor)-Byte(ForeColor))*ATransparent;
G:=Byte(ForeColor shr 8)+
(

来自: Imfish, 时间: 2003-03-06 10:37:00, ID: 1659290
发了才知道有人已经发了，浪费空间，不好意思[]

来自: dream0, 时间: 2004-07-07 15:35:18, ID: 2700651
上二楼的朋友，不要讲这么多撒，我看到这么长就不想看了


得分大富翁: c2008-10,DEN-10,goddy-10,michael.fly-50,Solid_Snake-5,康凌-5,墙头草-5,雨人-5,

问题: 老问题：半透明窗体？？ ( 积分: 200 )
分类: 系统相关

来自: pos0637, 时间: 2003-01-17 23:33:00, ID: 1587308
有没有哪位大虾可以给出98下实现半透明的源代码
不要以下这种的，例如说：
procedure TForm1.TranslucentBmp(Bmp:
TBitmap;AColor:TColor;ATransparent:Longint);
var BkColor:COLORREF;
ForeColor:Longint;
R,G,B:Int64;
i,j:Integer;
begin
ForeColor:=ColorToRGB(AColor);
with Bmp.Canvas do
for i:=ClientHeight-1 downto 0 do
for j:=ClientWidth-1 downto 0 do
begin
BkColor:=GetPixel(Handle,j,i); //取得每一象素
R:=Byte(ForeColor)+
(Byte(BkColor)-Byte(ForeColor))*ATransparent;
G:=Byte(ForeColor shr 8)+
(Byte(BkColor shr 8)-Byte(ForeColor
shr 8))*ATransparent;
B:=Byte(ForeColor shr 16)+
(Byte(BkColor shr 16)-Byte(ForeColor
shr 16))*ATransparent;
SetPixelV(Handle,j,i,RGB(R,G,B));//合成象素
end;
end;
也不要什么 Brush.Style := bsNone; 这种的
有没有更好的 能实现像Win2K中的半透明的？？

来自: daoba_wolf, 时间: 2003-01-17 23:48:00, ID: 1587316
用delphi7就可轻实现!

来自: qinmingzsj, 时间: 2003-01-18 12:44:00, ID: 1587694
在delphi6中,設置ALPHABLEND=TRUE; ALPHABLEND=185;

来自: volcanosh, 时间: 2003-01-18 12:55:00, ID: 1587713
在xp下有效，98下无效，你看flashget的下载框就知道了。

来自: heijuanma, 时间: 2003-01-18 13:57:00, ID: 1587820
同意：qinmingzsj

来自: linuxer, 时间: 2003-01-18 15:41:00, ID: 1587970
qinmingzsj的只对W2K以下的OS有效

来自: 41426277, 时间: 2003-01-18 17:59:00, ID: 1588196
半透明窗体
半透明窗体并不是win2000的新特效，凡是用过金山词霸的同志都会发现在屏幕取词设置中有一个半透明背景的选项，这说明在win98下是可以实现半透明窗口的。但我还是要首先谈谈在win2000实现半透明窗体的新函数setlayeredwindowattributes。利用这个函数就可以轻松创建一个半透明窗体，但是利用这个函数的程序编译后在win98下是无法运行的。

setlayeredwindowattributes api函数介绍如下： 函数功能：设置窗口透明颜色 参数：setlayeredwindowattributes( hwnd hwnd, //窗口手柄 colorref crkey, //指定颜色值 byte balpha, //混合函数值 dword dwflags //动作 参数解释： hwnd:窗口句柄。当使用createwindowex函数创建窗口时，窗口由ws_ex_layered指定的值创建；或者窗口已经创建后，由setwindowlong根据ws_ex_layered指定的值改变。 crkey:指向一个color值，该值指定一个透明颜色值，当创建窗口时，窗口将使用该值。 balpha:混合函数值。该值用于描述窗口的不透明度。当balpha 值为0时，窗口完全透明，当balpha值为255时，窗口完全不透明。 dwflags:指定动作。这个参数可以取一个或多个值。用它我们可以创建一个不规则的窗体。

setlayeredwindowattributes函数的api声明: setlayeredwindowattributes(hwnd: hwnd; crkey: dword;balpha: byte; dwflag: dword): boolean; stdcall; ---------

程序代码1： const ws_ex_layered = $80000; lwa_colorkey = $1; lwa_alpha = $2; procedure tform1.formcreate(sender: tobject); var l:longint; begin l :=getwindowlong(handle, gwl_exstyle); l := l or ws_ex_layered; setwindowlong (handle, gwl_exstyle, l); setlayeredwindowattributes(handle, 180, 120, lwa_alpha); end; 还有一些其它的常量定义如: ac_src_alpha = $1; ac_dst_no_premult_alpha = $10; ulw_colorkey = $1; ulw_alpha = $2; ulw_opaque = $400; 等还要参看msdn。

有些我还没有搞明白，如果哪位同志知道的话，请告诉我。 那么在win98下又是如何实现半透明窗体的呢?其基本原理是:在窗口显示前其获取背景图然后对背景图象进行滤镜效果处理再将处理过的背景图象显示在窗口前面。 有一种方法是:首先，做出一个透明窗体，然后在窗体上添加一个shape，将其扩展至全屏幕，将shape的pen的mode属性设为pmmask,pen的style属性设为psclear,最后改变brush的color属性即可。 因为没有api支持，win9x下只能模拟，效果不太好，就象金山词霸的取词窗口，背景改变而窗体上还是不变。但我们可以利用timer控件来解决窗体的刷新率和时时更新的问题。 不过听说“金山词霸的半透明窗口效果只能在带mmx指令集的处理器中才起作用”不知是真是假，由于手头没有这样的电脑，还请同志们自己验证吧。



--------------------------------------------------------------------------------


在windows2000下增加了一些API,可以轻易的实现半透明的窗体，源程序如下，必要的地方我加上了注释

unit Unit1;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

const

WS_EX_LAYERED = $80000;

AC_SRC_OVER = $0;

AC_SRC_ALPHA = $1;

AC_SRC_NO_PREMULT_ALPHA = $1;

AC_SRC_NO_ALPHA = $2;

AC_DST_NO_PREMULT_ALPHA = $10;

AC_DST_NO_ALPHA = $20;

LWA_COLORKEY = $1;

LWA_ALPHA = $2;

ULW_COLORKEY = $1

ULW_ALPHA = $2

ULW_OPAQUE = $4

//新增加的常量定义

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

function SetLayeredWindowAttributes(hwnd:HWND; crKey:Longint; bAlpha:byte; dwFlags:longint ):longint; stdcall; external user32;//函数声明

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);

var l:longint;

begin

l:=getWindowLong(Handle, GWL_EXSTYLE);

l := l Or WS_EX_LAYERED;

SetWindowLong (handle, GWL_EXSTYLE, l);

SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);

//第二个参数是指定透明颜色

//第二个参数为0则使用第四个参数设置alpha值，从0到255，其他的我不太清楚，因为没有api帮助

end;







end.




来自: zw84611, 时间: 2003-01-18 21:25:00, ID: 1588418
unit main;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, Buttons, Mask;

type
TForm1 = class(TForm)
Exit: TButton;
Shape1: TShape;
Image1: TImage;
HalfTranSparent: TButton;
Label1: TLabel;
Edit1: TEdit;
procedure ExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure HalfTranSparentClick(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure GetBKBmp;
procedure MakeTransparent(bmp:TBitMap;Transparence:longint);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }

public
{ Public declarations }
end;

var
Form1: TForm1;
BKImage: TBitMap;

implementation

{$R *.DFM}
procedure TForm1.ExitClick(Sender: TObject);
begin
close;
end;

procedure TForm1.MakeTransparent(bmp: TBitMap; Transparence: Integer);
var
bkcolor:colorref;
r,g,b:int64;
i,j:integer;
begin
with bmp.Canvas do
for i:=clientheight-1 downto 0 do
for j:=clientwidth-1 downto 0 do
begin
bkcolor:=getpixel(handle,j,i);
r:=(byte(bkcolor))*Transparence div 100;
g:=(byte(bkcolor shr 8))*Transparence div 100;
b:=(byte(bkcolor shr 16))*Transparence div 100;
setpixelv(handle,j,i,rgb(r,g,b));
end;
end;

Procedure TForm1.GetBKBmp;
var
s:TCanvas;
h,w:integer;
begin
s:=TCanvas.Create;
h:=clientheight;
w:=clientwidth;
try
Form1.Visible:=False;
sleep(50);
s.Handle:=getdc(0);
BKImage.Canvas.CopyRect(rect(0,0,w,h),s,rect(left,top,left+w,top+h));
releasedc(0,s.handle);
Sleep(50);
Form1.Visible:=true;
finally
s.free;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
BKImage:=TBitMap.Create;
BKImage.Height:=Image1.Height;
BKImage.Width:=Image1.Width;
BKImage.PixelFormat:=pf24bit;
try
GetBKBmp;
MakeTransparent(BKImage,70);
Image1.Picture.Bitmap:=BKImage;
finally
end;
end;

procedure TForm1.HalfTransparentClick(Sender: TObject);
var
i:integer;
begin
i:=strtoint(edit1.text);
try
GetBKBmp;
MakeTransparent(BKImage,i);
Image1.Picture.Bitmap:=BKImage;
finally
end;
Image1.Refresh;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
Perform(WM_SYSCOMMAND,$F012,0);
HalfTransparentClick(nil);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
BKImage.Free;
end;

end.

但移动时效果不好。


来自: pos0637, 时间: 2003-01-18 21:34:00, ID: 1588426
请注意：
各位的源代码实现的半透明窗体，当窗体后面的东西发生变化时不能反映出来，
而Win2K是可以实现这点的


来自: 有故事的人, 时间: 2003-01-20 4:08:00, ID: 1589822
在delphi6中,設置ALPHABLEND=TRUE; ALPHABLEND=185;只对2K有用。
这里抄别人的也太多了，一字都不改，让人感到有点。。。。。。。。。。。

来自: lfpsoft, 时间: 2003-01-20 7:50:00, ID: 1589836
SkinEngine这个控件能够做到！

来自: SPYSKY, 时间: 2003-01-20 8:05:00, ID: 1589842
http://www.ithome-cn.net/technology/delphi/de098.htm




来自: seraph_q, 时间: 2003-01-21 23:59:00, ID: 1592111
Win2000本身就支持半透明窗体，而Win98则不支持。如果想在Win98下实现半透明，
除了在显示窗口前把背景拷贝下来做Alpha混合，我想不会有别的办法。但是这样的
方法其实是假的半透明，如果背景变了是无法及时更新的。

结论：放弃98

来自: chatop, 时间: 2003-01-26 13:56:00, ID: 1599719
98好像很麻烦的
以前看过一个文章说是把窗口下面的界面copy出来，做为窗体的背景然后对背景进行透明，不过我觉得
这种方法不怎么好哦，太占资源

来自: 5415, 时间: 2003-01-26 23:28:00, ID: 1600331
试试我的这个
unit JtoCXPAuto;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ShellApi;

type
TAutoForm = class(TForm)
BackImg: TImage;
procedure FormShow(Sender: TObject);
procedure BackImgMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BackImgMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;

var
AutoForm: TAutoForm;
EMailRect:TRect;
implementation



{$R *.dfm}

procedure TAutoForm.FormShow(Sender: TObject);
var
ScreenDc,DestDc:Hdc;
BHandle:THandle;
X,Y:integer;
Color:TColor;
Color1,Color2,Color3:Byte;
FormRgn:Hrgn;
begin
FormRgn:=CreateRoundRectRgn(0,0,Width,Height,15,15);
SetWindowRgn(Handle,FormRgn,True);

EnableWindow(MainForm.Handle,False);
ScreenDc:=CreateDc(/'DISPLAY/',nil,nil,nil);
DestDc:=CreateCompatibleDc(ScreenDc);
BHandle:=CReateCompatibleBitmap(ScreenDc,Width,Height);
SelectObject(DestDc,Bhandle);
BitBlt(DestDc,0,0,Width,Height,ScreenDc,MainForm.Left+(MainForm.Width -Width)div 2,
MainForm.Top +(MainForm.Height -Height)div 2,SRCCOPY);
for x:=0 to Width-1 do begin
for y:=0 to Height-1 do begin
Color:=GetPixel(DestDc,x,y);
Color1:=GetRValue(Color) div 3;
Color2:=GetGValue(Color) div 3;
Color3:=GetBValue(Color) div 3;
Color:=RGB(Color1,Color2,Color3);
SetPixel(DestDC,x,y,Color);
end;
end;
BitBlt(BackImg.Canvas.Handle,0,0,Width,Height,DestDC ,0,0,SRCCOPY);
DeleteDc (DestDc);
ReleaseDc (Bhandle,ScreenDc);
with BackImg.Canvas do begin
Moveto(0,0);
Pen.Color :=rgb(192,192,192);
Lineto(BackImg.Width -1,0);
// Pen.Color :=rgb(64,64,64);
Lineto(BackImg.Width -1,backImg.Height -1);
Lineto(0,BackImg.Height-1);
Pen.Color :=rgb(192,192,192);
Lineto(0,0);

Font.Size :=16;
Font.Color :=RGB(255,255,255);
Brush.Style :=bsClear;
TextOut((Width-TextWidth(/'欢迎你使用---对译/'))div 2,5,/'欢迎你使用---对译/');
Font.Size :=12;
TextOut(20,40,/'版本信息：/');
TextOut(120,40,/'( 2002.03.08 )/');
TextOut(20,70,/'电子邮件：/');
TextOut((Width-TextWidth(/'这是我个人编写的,请指教!/'))div 2,105,/'这是我个人编写的,请指教!/');
Font.Color :=Rgb(255,0,0);
Font.Style :=[fsUnderline];
TextOut(120,70,/'sbjane9@163.com/');
end;
end;

procedure TAutoForm.BackImgMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
pt:Tpoint;
begin
GetCursorpos(pt);
if PtinRect(EMailRect,pt) then begin
ShellExecute(handle,nil,pchar(/'MailTo:/'+MyEmail),nil,nil,SW_SHOWNORMAL);
exit;end
else begin
AutoForm.Close;
EnableWindow(MainForm.Handle,True);
end;
end;

procedure TAutoForm.BackImgMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
Pt:Tpoint;
begin
EMailRect:=Bounds(Left+120,Top+70,16*12,14);
GetCursorpos(pt);
if PtinRect(EMailRect,pt) then
Cursor:=crHandPoint
else
Cursor:=crDefault;

end;

end.

来自: pos0637, 时间: 2003-01-30 14:08:00, ID: 1604809
多人接受答案了。

得分大富翁: 41426277-10,5415-10,chatop-10,daoba_wolf-10,heijuanma-10,lfpsoft-10,linuxer-10,qinmingzsj-10,seraph_q-10,SPYSKY-10,volcanosh-10,zw84611-40,有故事的人-50,

还是用简单的函数好