100分——求图片交替淡入淡出 ( 积分: 100 )

各位大侠帮帮小弟，我想实现打开界面后多张图片（格式bmp或jpg）随时间淡入淡出的交替变化的效果，望多多赐教。

各位大侠帮帮小弟，我想实现打开界面后多张图片（格式bmp或jpg）随时间淡入淡出的交替变化的效果，望多多赐教。

delphi7 编程百例（或是专家门诊）上有例子。到tomore上找找。

或用PicShow控件，很小也很好用。

楼主参考一下下面的代码:
procedure TfrmMain.Button1Click(Sender: TObject);

var

sBlendFunction: BlendFunction;

// 这是Alpha混合时需要的一个类型参数

i: byte;

begin

if Button1.Caption='淡入' then

begin

Button1.Caption:='淡出';

with sBlendFunction do

// 设置初值

begin

BlendOp := AC_SRC_OVER;

// 目前惟一支持的一种混合方式

BlendFlags := 0;

// 必须为零

AlphaFormat := 0

// 默认

end;

for i := 0 to 51 do // 共有51帧

begin

sBlendFunction.SourceConstantAlpha:= i * 5;

// 从全透明到不透明，每次渐变5级

Windows.AlphaBlend(Image1.Canvas.Handle,0,0,Image1.Width,

Image1.Height,Bitmap.Canvas.Handle,0,0,

Bitmap.Width,Bitmap.Height,sBlendFunction);

// Alpha混合处理

sleep(50);

// 延时50毫秒，适当的延时可让效果看起来更逼真

Image1.Refresh;

// 一定要实时刷新Image1，才能看出变化

end;

end

else

begin

Button1.Caption:='淡入';

with sBlendFunction do

begin

BlendOp := AC_SRC_OVER;

BlendFlags := 0;

AlphaFormat := 0;

end;

for i := 0 to 51 do

begin

sBlendFunction.SourceConstantAlpha:= i * 5;

Windows.AlphaBlend(Image1.Canvas.Handle,0,0,Image1.Width,

Image1.Height,Bitmap.Canvas.Handle,0,0,

1,1,sBlendFunction);

sleep(50);

Image1.Refresh;

end;

end;

end;

to shine007：谢谢，但我不想用控件来实现；
to ff_ff：程序有点小问题，不过运行后可以看到淡入淡出，但是淡出后图片原先的背景颜色不能变为透明。

32位图像处理库简单实现(原创)
unit Image32;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, StdCtrls, ComCtrls, ToolWin, ImgList, Jpeg,Buttons, Math, Trace, mmsystem;

const
PixelCountMax = 32768;


type
TRGBQuad = packed record
rgbBlue: BYTE;
rgbGreen: BYTE;
rgbRed: BYTE;
rgbReserved: BYTE;
end;


PColor32 = ^TColor32;
TColor32 = type Cardinal;

PColor32Array = ^TColor32Array;
TColor32Array = array [0..0] of TColor32;
TArrayOfColor32 = array of TColor32;

pRGBQuadArray = ^TRGBQuadArray;
TRGBQuadArray = array[0..PixelCountMax - 1] of TRGBQuad;

PRGBArray = ^TRGBArray;
{* RGB数组指针}
TRGBArray = array[0..8192] of tagRGBTriple;
{* RGB数组类型}

function RedComponent(Color32: TColor32): Integer;
function GreenComponent(Color32: TColor32): Integer;
function BlueComponent(Color32: TColor32): Integer;
function AlphaComponent(Color32: TColor32): Integer;
function Intensity(Color32: TColor32): Integer;
function RGBA(R, G, B: Byte; A: Byte = $FF): TColor32;
function RGBAToColor32(RGBA: TRGBQuad): TColor32;
function Color32ToRGBA(Color32: TColor32): TRGBQuad;

// 汇编语言实现32位填充
procedure FillLongword(var X; Count: Integer; Value: Longword);

// 一些预先设定32位颜色（格式为ARGB)

const
clBlack32 : TColor32 = $FF000000;
clDimGray32 : TColor32 = $FF3F3F3F;
clGray32 : TColor32 = $FF7F7F7F;
clLightGray32 : TColor32 = $FFBFBFBF;
clWhite32 : TColor32 = $FFFFFFFF;
clMaroon32 : TColor32 = $FF7F0000;
clGreen32 : TColor32 = $FF007F00;
clOlive32 : TColor32 = $FF7F7F00;
clNavy32 : TColor32 = $FF00007F;
clPurple32 : TColor32 = $FF7F007F;
clTeal32 : TColor32 = $FF007F7F;
clRed32 : TColor32 = $FFFF0000;
clLime32 : TColor32 = $FF00FF00;
clYellow32 : TColor32 = $FFFFFF00;
clBlue32 : TColor32 = $FF0000FF;
clFuchsia32 : TColor32 = $FFFF00FF;
clAqua32 : TColor32 = $FF00FFFF;

// 一些半透明32位颜色（格式为ARGB)
clTrWhite32 : TColor32 = $7FFFFFFF;
clTrBlack32 : TColor32 = $7F000000;
clTrRed32 : TColor32 = $7FFF0000;
clTrGreen32 : TColor32 = $7F00FF00;
clTrBlue32 : TColor32 = $7F0000FF;

type
TBitmap32 = class(TBitmap)
private

protected
public
constructor Create; override;
destructor Destroy; override;

procedure Assign(Source: TPersistent); override; //重载，设置为32位
procedure LoadFromFile(const Filename: string); override; //重载，设置为32位

// 这两个函数引用自FLIB库//
// 只处理目标ALPHA通道时,两个函数可以替换到用 //

// 注意这里一下, 替换时请在DrawTo,DrawFrom 里面替换就可以了

// CombinAlphaPixel是以目标及源像素的ALPHA通道合成
procedure CombineAlphaPixel(var pDest: TRGBQuad; cr1: TRGBQuad; nAlpha1: integer; cr2: TRGBQuad; nAlpha2: integer);
// AlphaBlendPixel是以目标的ALPHA通道合成
procedure AlphaBlendPixel(var pDest: TRGBQuad; pSrc: TRGBQuad);


function GetBits: PColor32Array;
procedure SetPixel(x, y: integer; color: TColor32);
function GetPixel(x, y: integer): TColor32;
procedure Clear(color: TColor32);overload;
procedure Clear(Bitmap: TBitmap; color: TColor32);overload;
procedure Clear;overload;
procedure FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32);

procedure SetAlphaChannels(Alpha: BYTE);overload; //设置纯色透明通道
procedure SetAlphaChannels(Bitmap: TBitmap; Alpha: Byte);overload; //设置其他图像纯色透明通道
procedure SetAlphaChannels(Mask8: TBitmap);overload; //把MASK设置为透明通道

procedure DrawFrom(DstX, DstY: Integer; Src: TBitmap32); //把32位图像写到自身
procedure DrawTo(DstX, DstY: Integer; Tge: TBitmap32);overload; //把自身写到32位图像
procedure DrawTo(DstX, DstY: Integer; Tge: TBitmap);overload; //把自身写到图像
end;

implementation

procedure FillLongword(var X; Count: Integer; Value: Longword);
asm
// EAX = X
// EDX = Count
// ECX = Value

PUSH EDI

MOV EDI,EAX // Point EDI to destination
MOV EAX,ECX
MOV ECX,EDX
TEST ECX,ECX
JS @exit

REP STOSD // Fill count dwords
@exit:
POP EDI
end;

function RedComponent(Color32: TColor32): Integer;
begin
Result := (Color32 and $00FF0000) shr 16;
end;

function GreenComponent(Color32: TColor32): Integer;
begin
Result := (Color32 and $0000FF00) shr 8;
end;

function BlueComponent(Color32: TColor32): Integer;
begin
Result := Color32 and $000000FF;
end;

function AlphaComponent(Color32: TColor32): Integer;
begin
Result := Color32 shr 24;
end;

function Intensity(Color32: TColor32): Integer;
begin
// (R * 61 + G * 174 + B * 21) / 256
Result := (
(Color32 and $00FF0000) shr 16 * 61 +
(Color32 and $0000FF00) shr 8 * 174 +
(Color32 and $000000FF) * 21
) shr 8;
end;

function RGBA(R, G, B: Byte; A: Byte = $FF): TColor32;
begin
Result := A shl 24 + R shl 16 + G shl 8 + B;
end;

function RGBAToColor32(RGBA: TRGBQuad): TColor32;
begin
Result := RGBA.rgbReserved shl 24 + RGBA.rgbRed shl 16 + RGBA.rgbGreen shl 8 + RGBA.rgbBlue;
end;

function Color32ToRGBA(Color32: TColor32): TRGBQuad;
var
RGBA: TRGBQuad;
begin
RGBA.rgbRed := RedComponent(Color32);
RGBA.rgbRed := GreenComponent(Color32);
RGBA.rgbRed := BlueComponent(Color32);
RGBA.rgbRed := AlphaComponent(Color32);
Result := RGBA;
end;

constructor TBitmap32.Create;
begin
inherited Create;
PixelFormat := pf32bit;
end;

destructor TBitmap32.Destroy;
begin
inherited Destroy;
end;

procedure TBitmap32.LoadFromFile(const Filename: string);
begin
inherited LoadFromFile(FileName);
PixelFormat := pf32bit;
end;

procedure TBitmap32.Assign(Source: TPersistent);
begin
inherited Assign(Source);
PixelFormat := pf32bit;
end;

function TBitmap32.GetBits: PColor32Array;
begin
Result := ScanLine[Height - 1]; //得到Bitmap32图像的起始地址
end;

procedure TBitmap32.DrawFrom(DstX, DstY: Integer; Src: TBitmap32);
var
x, y: integer;
TR, SR: TRect;
Source, Target: pRGBQuadArray;
begin

TR := Rect(0, 0, Width, Height);
SR := Rect(DstX, DstY, DstX + Src.Width, DstY + Src.Height);

if IntersectRect(TR, TR, SR) = false then
exit;

for y := Tr.Top to Tr.Bottom - 1 do
begin
Source := Src.ScanLine[y - Dsty];
Target := ScanLine[y];
for x := TR.Left to Tr.Right - 1 do
begin
CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
end;
end;
end;

procedure TBitmap32.DrawTo(DstX, DstY: Integer; Tge: TBitmap32);
var
x, y: integer;
TR, SR: TRect;
Source, Target: pRGBQuadArray;
begin

TR := Rect(0, 0, TGe.Width, Tge.Height);
SR := Rect(DstX, DstY, DstX + Width, DstY + Height);

if IntersectRect(TR, TR, SR) = false then
exit;

for y := Tr.Top to Tr.Bottom - 1 do
begin
Target := Tge.ScanLine[y];
Source := ScanLine[y - Dsty];
for x := TR.Left to Tr.Right - 1 do
begin
CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
end;
end;

end;

procedure TBitmap32.DrawTo(DstX, DstY: Integer; Tge: TBitmap);
var
x, y: integer;
TR, SR: TRect;
Source, Target: pRGBQuadArray;
begin
Tge.PixelFormat := pf32bit;
SetAlphaChannels(Tge, $FF);

Tr := Rect(0, 0, Tge.Width, Tge.Height);
SR := Rect(DstX, DstY, DstX + Width, DstY + Height);

if IntersectRect(Tr, Tr, SR) = false then
exit;

for y := Tr.Top to Tr.Bottom - 1 do
begin
Target := Tge.ScanLine[y];
Source := ScanLine[y - Dsty];
for x := Tr.Left to Tr.Right - 1 do
begin
CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
end;
end;

end;


procedure TBitmap32.Clear(color: TColor32);
var
x, y: integer;
begin
FillLongword(GetBits^[0], Width * Height, Color);
end;

procedure TBitmap32.Clear(Bitmap: TBitmap; color: TColor32);
var
bits: PColor32Array;
begin
Bitmap.PixelFormat := pf32bit;
bits := Bitmap.ScanLine[Bitmap.Height - 1];

FillLongword(Bits^[0], Width * Height, Color);
end;


procedure TBitmap32.Clear;
begin
Clear(clBlack32);
end;

procedure TBitmap32.FillRect(X1, Y1, X2, Y2: Integer; Value: TColor32);
var
j: Integer;
P: PColor32Array;
begin
for j := Y1 to Y2 - 1 do
begin
P := Pointer(ScanLine[j]);
FillLongword(P[X1], X2 - X1, Value);
end;
end;

procedure TBitmap32.SetAlphaChannels(Alpha: BYTE);
var
x, y: integer;
SS: pRGBQuadArray;
begin
for y := 0 to Height-1 do
begin
SS := ScanLine[y];
for x := 0 to Width-1 do
begin
SS^[x].rgbReserved := Alpha;
end;
end;
end;

procedure TBitmap32.SetAlphaChannels(Mask8: TBitmap);
var
x, y: integer;
DS: pRGBQuadArray;
SS: pByteArray;
begin
for y := 0 to Height-1 do
begin
DS := ScanLine[y];
SS := Mask8.ScanLine[y];
for x := 0 to Width-1 do
begin
DS^[x].rgbReserved := SS^[x];
end;
end;
end;


procedure TBitmap32.SetAlphaChannels(Bitmap: TBitmap; Alpha: Byte);
var
x, y: integer;
SS: pRGBQuadArray;
begin
for y := 0 to Bitmap.Height-1 do
begin
SS := Bitmap.ScanLine[Bitmap.Height - y -1];
for x := 0 to Bitmap.Width-1 do
begin
SS^[x].rgbReserved := Alpha;
end;
end;
end;

procedure TBitmap32.SetPixel(x, y: integer; color: TColor32);
begin
if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
GetBits^[x + (Height - y -1) * Width] := color;
end;

function TBitmap32.GetPixel(x, y: integer): TColor32;
begin
Result := $00000000;
if (X >= 0) and (X < Width) and (Y >= 0) and (Y < Height) then
Result := GetBits^[x + (Height - y -1) * Width];
end;

procedure TBitmap32.AlphaBlendPixel(var pDest: TRGBQuad; pSrc: TRGBQuad);
begin
if (pSrc.rgbReserved = $FF) then
begin
PRGBArray(pDest) := PRGBArray(pSrc);
exit;
end;

if (pSrc.rgbReserved = 0) then
exit;
// 以下用不着判断[0,0xFF]，我验算过了

if (PRGBArray(pSrc) <> PRGBArray(pDest)) then
begin
pDest.rgbBlue := (PSrc.rgbBlue - pDest.rgbBlue) * pSrc.rgbReserved div $FF + pDest.rgbBlue;
pDest.rgbGreen := (PSrc.rgbGreen - pDest.rgbGreen) * pSrc.rgbReserved div $FF + pDest.rgbGreen;
pDest.rgbRed := (PSrc.rgbRed - pDest.rgbRed) * pSrc.rgbReserved div $FF + pDest.rgbRed;
end;
end

//===================================================================
// 计算两个32bit象素的等效象素，这个函数非常重要(speed)，安全检查就不做了
// cr1：背景 cr2：前景

procedure TBitmap32.CombineAlphaPixel(var pDest: TRGBQuad; cr1: TRGBQuad; nAlpha1: integer; cr2: TRGBQuad; nAlpha2: integer);
var
nTmp1, nTmp12, nTemp, nTmp2: integer;
begin
if ((nAlpha1 <> 0) or (nAlpha2 <> 0)) then
begin
if (nAlpha2 = 0) then
begin
pDest.rgbBlue := cr1.rgbBlue ;
pDest.rgbGreen := cr1.rgbGreen ;
pDest.rgbRed := cr1.rgbRed ;
pDest.rgbReserved := nAlpha1 ;
exit;
end;
if ((nAlpha1 = 0) or (nAlpha2 = $FF)) then
begin
pDest.rgbBlue := cr2.rgbBlue ;
pDest.rgbGreen := cr2.rgbGreen ;
pDest.rgbRed := cr2.rgbRed ;
pDest.rgbReserved := nAlpha2 ;
exit;
end;

// 以下用不着判断[0,0xFF]，我验算过了
nTmp1 := $FF * nAlpha1;
nTmp2 := $FF * nAlpha2 ;
nTmp12 := nAlpha1 * nAlpha2;
nTemp := nTmp1 + nTmp2 - nTmp12 ;
pDest.rgbBlue := (nTmp2 * cr2.rgbBlue + (nTmp1 - nTmp12) * cr1.rgbBlue) div nTemp ;
pDest.rgbGreen := (nTmp2 * cr2.rgbGreen + (nTmp1 - nTmp12) * cr1.rgbGreen) div nTemp ;
pDest.rgbRed := (nTmp2 * cr2.rgbRed + (nTmp1 - nTmp12) * cr1.rgbRed) div nTemp ;
pDest.rgbReserved := nTemp div $FF ;

// 下面的代码是未优化过的，可读性更好些
{
nTemp := $FF * (nAlpha1 + nAlpha2) - nAlpha1*nAlpha2 ;
pDest.rgbBlue := min($FF, ($FF * cr2.rgbBlue * nAlpha2 + ($FF - nAlpha2) * cr1.rgbBlue * nAlpha1) div nTemp) ;
pDest.rgbGreen := min($FF, ($FF * cr2.rgbGreen * nAlpha2 + ($FF - nAlpha2) * cr1.rgbGreen * nAlpha1) div nTemp) ;
pDest.rgbRed := min($FF, ($FF * cr2.rgbRed * nAlpha2 + ($FF - nAlpha2) * cr1.rgbRed * nAlpha1) div nTemp) ;
pDest.rgbReserved := nTemp div $FF ;
}
end
else
begin
pDest.rgbBlue := $FF;
pDest.rgbGreen := $FF;
pDest.rgbRed := $FF;
pDest.rgbReserved := 0 ;
end;
end;


end.


用上面这个,在配合GraphicEx这个打开文件控件，也可以不用，只打开一个Bmp文件

var
Bitmap :TBitmap32;
begin
Bitmap := TBitmap32.Create; ////这个类只能用于32位位图

Bitmap.LoadFormFile('test.bmp');
//如果是24位位图的话
//就必须设置图像的Alpha通道，也就是透明度
//Bitmap.SetAlphaChannels($0); //$0 ... $FF $0为不透明 $FF为不透明

Bitmap.DrawTo(0,0,Image1.Picture.Bitmap);//这里是把自身画到画布上;

Bitmap.Free;

//如果要实现淡入谈出的话
// pDest: 目标 cr1：背景 cr2：前景
//請使用上面的函数CombineAlphaPixel(var pDest: TRGBQuad; cr1: TRGBQuad; nAlpha1: integer; cr2: TRGBQuad; nAlpha2: integer);
//修改为
//procedure TBitmap32.DrawTo(DstX, DstY: Integer; Tge: TBitmap);
procedure TBitmap32.Fade(DstX, DstY: Integer; Tge: TBitmap; fadeint: integer);
var
x, y: integer;
TR, SR: TRect;
Source, Target: pRGBQuadArray;
begin
Tge.PixelFormat := pf32bit;
SetAlphaChannels(Tge, (255-fadeint)); //设置目标图像的透明度

SetAlphaChannels(fadeint); //设置源图像的透度

Tr := Rect(0, 0, Tge.Width, Tge.Height);
SR := Rect(DstX, DstY, DstX + Width, DstY + Height);

if IntersectRect(Tr, Tr, SR) = false then
exit;

for y := Tr.Top to Tr.Bottom - 1 do
begin
Target := Tge.ScanLine[y];
Source := ScanLine[y - Dsty];
for x := Tr.Left to Tr.Right - 1 do
begin
CombineAlphaPixel(Target^[x], Target^[x], Target^[x].rgbReserved, Source^[x - DstX], Source^[x- DstX].rgbReserved);
end;
end;

end;

谢谢各位了，受教，我再琢磨一下[]