http://www.csdn.net/Expert/topic/461/461963.shtm
怎么都没有人来
怎么都没有人来
解决方案 »
- 关于自己编写图像处理功能的一些疑问?
- 如何生成不用注册的dll?
- 如何用delphi调用java开发的web service程序
- 急:整数转换成ASCII码
- 一个关于组件的权限问题
- 谁读过《DELPHI 5企业级解决方案及应用剖析》
- 我创建了一个COM,注册通过,VBS创建也没问题,但所有接口都找不到,请指点。(带源码)
- 请各位高手帮忙杀毒!!!
- ★★关于图形缩放时失真的问题★★????????????
- 如何delphi通过bde的sql link连接oracle数据库,是否要安装一个oracle客户端
- 如何把一表中内容调入一空表中?
- 有谁对WINDOWS系统控制程序感兴趣,交个朋友吧。 我在写公司的网吧管理程序.
AnimateWindow(Self.Handle, 250, AW_BLEND or AW_ACTIVATE);
AnimateWindow(Self.Handle, 250, AW_BLEND or AW_ACTIVATE);
后面所说的alphaband,应该是说错了,应该是alphablend,这个到可以用在98以上,但是这只是处理图片,因此你用它来处理窗口可能自己要多做一点事情。
如果你要做半透明的过渡过程,效果并不好,太慢!
AlphaBlend函数可以进行淡入淡出效果:
利用API函数实现图像淡入淡出效果
一般传统的实现两个PictureBox之间图像的淡入淡出效果都需要使用大量的API函数并进行复杂的调色板以及
绘图设备(Device Context)的操作。但是在Win98、Win2000中,微软提供了支持透明图像拷贝的AlphaBlend函数。
这篇文章就介绍如何通过API函数AlphaBlend实现PictureBox之间图像的淡入淡出效果。AlphaBlend函数的定义在
msimg32.dll中,一般Win98、Win2000都带了这个库,在编程之前你可以先察看一下该文件是否存在。
打开VB建立一个新工程。选择菜单 Project | Add Module 添加一个模块到工程中,在其中输入以下代码:Public Type rBlendProps
tBlendOp As Byte
tBlendOptions As Byte
tBlendAmount As Byte
tAlphaType As Byte
End TypePublic Declare Function AlphaBlend Lib "msimg32" (ByVal hDestDC As Long, _
ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal widthSrc As Long, _
ByVal heightSrc As Long, ByVal blendFunct As Long) As BooleanPublic Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long) 大家可以看到,AlphaBlend函数的定义同普通的复制函数Bitblt很相似,只是最后的参数blendFunct定义为一个
rBlendProps结构。那么为什么在函数定义中blendFunct 定义为Long类型呢?因为rBlendProps结构长度是4个字节。
而Long类型变量的长度也是4个字节,那么我们就可以程序中通过API函数CopyMemory将一个rBlendProps结构拷贝到
blendFunct 中。 在Form1中添加两个PictureBox控件,其中Picture2为源,Picture1为拷贝目标,将两者的ScaleMode都设置为3-Pixel
将两者的AutoRedraw属性都设置为True,然后分别添加图像。在加入一个Timer控件以及一个CommandButton控件,然后
在Form1的代码窗口中添加如下代码:Dim lTime As ByteSub ShowTransparency(cSrc As PictureBox, cDest As PictureBox, _
ByVal nLevel As Byte)
Dim LrProps As rBlendProps
Dim LnBlendPtr As Long
cDest.Cls
LrProps.tBlendAmount = nLevel
CopyMemory LnBlendPtr, LrProps, 4
With cSrc
AlphaBlend cDest.hDC, 0, 0, .ScaleWidth, .ScaleHeight, _
.hDC, 0, 0, .ScaleWidth, .ScaleHeight, LnBlendPtr
End With
cDest.Refresh
End SubPrivate Sub Command1_Click()
lTime = 0
Timer1.Interval = 100
Timer1.Enabled = True
End Sub
Private Sub Timer1_Timer()
lTime = lTime + 1
ShowTransparency Picture2, Picture1, lTime
If lTime >= 255 Then
Timer1.Enabled = False
End If
Me.Caption = Str(Int(lTime / 2.55)) + "%"
End Sub 运行程序,点击Command1,就可以看到Picture2图像拷贝到Picture1上的淡入淡出效果了。
在结构rBlendProps中,最重要的参数就是tBlendAmount,该值决定了源与目标之间的透明程序。如果为0的话,源完全
透明,如果为255的话,源完全覆盖目标。
另外AlphaBlend 函数不只用于两个PictureBox之间的拷贝,而且可以在两个Device Context之间的透明拷贝,也就是
说,象窗口等控件之间也可以实现透明效果。不过在编程过程中发现一个问题,不知是否是AlphaBlend的Bug,就是在我写完
程序后,并没有出现透明复制的效果。搞的我以为该函数不起作用,但是当我再打开VB运行上面的程序后,一切有正常了。
我在MSDN上也没有找到相关的Bug列表。
如何制作半透明窗口 ---- 用过金山词霸的朋友,一定会为其半透明的翻译提示窗口而称奇。究竟这种窗口是如何做出来的呢?下面我们将来探讨这种半透明的窗口的制作方法。 一、 原理
---- 首先,我们先从透明窗口说起,其实透明窗口就是可以透过窗口看到它背景。所以,我们可以将窗口后面的背景图象,显示在窗口前面,就可实现透明窗口的效果了。至于半透明的效果,是在透明的基础上,加上一层滤镜,使看到的背景模糊一点而已。所以,在拿到背景图象后,先在该图象加上一层滤镜(把图象弄模糊),然后再显示在窗口上,就能达到半透明的效果。
---- 我们可归纳出实现半透明窗口的步骤:在窗口显示前其获取背景图 → 对背景图象进行滤镜效果处理 → 将处理过的背景图象显示在窗口前面。 ---- (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;interfaceuses
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(Handle,j,i,RGB(R,G,B));//合成象素
end;
end;procedure TForm1.FormCreate(Sender: TObject);
var BackgroundBmp:TBitmap;
begin
try
BackgroundBmp:=Tbitmap.Create;
//建立窗口背景图
BackgroundBmp.PixelFormat:=pf24bit;
//指定该图是24位真彩色
BackgroundBmp:=GetBackgroundBmp;
//取得窗口背景图
TranslucentBmp(BackgroundBmp,clBlack,50);
//对该图象进行滤镜处理
Image1.Picture.Bitmap:=BackgroundBmp;
//将处理过的图象显示出来
finally
BackgroundBmp.Free;
end;
end;procedure TForm1.SpeedButton1Click
(Sender: TObject);
begin
Close;
end;end.---- 程序的运行效果如图(一)所示。
三、 结束语
---- 需要说明的是:由于受到以上滤镜算法的速度影响,所以窗口显示时有所延迟,在窗口频繁显示和关闭时不是很流畅