图形特效 三

                             交错显示图像效果
   输入参数:
     Image       要进行垂直交错特效的TImage
     Direction   方向
     SleepTime   特效的快慢控制
}
procedure Img_Intervein(Image:TImage;Direction,SleepTime:Word);
var
i,j,BmpHeight,BmpWidth:Integer;
OldBmp:TBitmap;
begin
OldBmp:=TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 BmpHeight:=OldBmp.Height;
 BmpWidth:=OldBmp.Width;
 i:=0;
 case Direction of
  verticalShow :begin
                 while i<=BmpHeight do
                 begin
                  j:=i;
                  while j>0 do
                  begin
                   Image.Canvas.CopyRect(Rect(0,j-1,BmpWidth,j),
                                         OldBmp.Canvas,
                                         Rect(0,BmpHeight-i+j-1,BmpWidth,BmpHeight-i+j));
                   Image.Canvas.CopyRect(Rect(0,BmpHeight-j,BmpWidth,BmpHeight-j+1),
                                         OldBmp.Canvas,
                                         Rect(0,i-j,BmpWidth,i-j+1));
                   j:=j-2;
                  end;
                  Image.Refresh;
                  Sleep(SleepTime);
                  i:=i+2;
                 end; 
                end;
  horizontalShow :begin
                   while i<=BmpWidth do
                   begin
                    j:=i;
                    while j>0 do
                    begin
                     Image.Canvas.CopyRect(Rect(j-1,0,j,BmpHeight),
                                           OldBmp.Canvas,
                                           Rect(BmpWidth-i+j-1,0,BmpWidth-i+j,BmpHeight));
                     Image.Canvas.CopyRect(Rect(BmpWidth-j,0,BmpWidth-j+1,BmpHeight),
                                           OldBmp.Canvas,
                                           Rect(i-j,0,i-j+1,BmpHeight));
                     j:=j-2;
                    end;
                    Image.Refresh;
                    Sleep(SleepTime);
                    i:=i+2;
                   end;
                  end;
  else Image.Picture.Bitmap.Assign(OldBmp);
 end;
finally
 OldBmp.Free;
end;
end;


const
{百叶窗图像常数}
verticalShow=1;       //垂直
horizontalShow=2;     //水平


{ 百叶窗图像效果
   输入参数:
     Image       要进行百叶窗特效的TImage
     GridCount   百叶窗的页数
     Direction   方向
     SleepTime   特效的快慢控制
}
procedure Img_Shutter(Image:TImage;Direction,GridCount,SleepTime:Word);
var
OldBmp:TBitmap;
i,j,BmpHeight,BmpWidth:Integer;
Count,loopCount:Integer;
begin
Oldbmp:= TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 BmpHeight:=OldBmp.Height;
 BmpWidth:=OldBmp.Width;
 if GridCount=0 then GridCount:=1;
 case Direction of
  verticalShow :begin
                 for i:=GridCount to BmpHeight do
                 begin
                  if (BmpHeight mod i)=0 then
                  begin
                   Count:=i;
                   break;
                  end;
                 end;
                 loopCount:=BmpHeight div Count;
                 for i:=0 to loopCount do
                  for j:=0 to Count do
                  begin
                   Image.Canvas.CopyRect(Rect(0,loopCount*j+i-1,BmpWidth,loopCount*j+i),
                                         OldBmp.Canvas, 
                                         Rect(0,loopCount*j+i-1,BmpWidth,loopCount*j+i));
                   Image.Refresh;
                   Sleep(SleepTime);
                  end;
                end;
  horizontalShow :begin
                   for i:=GridCount to BmpWidth do
                   begin
                    if (BmpWidth mod i)=0 then
                    begin
                     Count:=i;
                     break;
                    end;
                   end;
                   loopCount:=BmpWidth div Count;
                   for i:=0 to loopCount do
                    for j:=0 to Count do
                    begin
                     Image.Canvas.CopyRect(Rect(loopCount*j+i-1,0,loopCount*j+i,BmpHeight),
                                           OldBmp.Canvas, 
                                           Rect(loopCount*j+i-1,0,loopCount*j+i,BmpHeight));
                     Image.Refresh;
                     Sleep(SleepTime);
                    end;
                  end;
  else Image.Picture.Bitmap.Assign(OldBmp);
 end;
finally
 OldBmp.Free;
end;
end;


{ 从中心向四周扩散逐渐显示图像特效
   输入参数:
     Image          要进行扩散特效的TImage
     CircleCount    扩散的圈数
     SleepTime      特效的快慢控制
}
procedure Img_CenterToAllBorderExpand(Image:TImage;CircleCount,SleepTime:Word);
var
i,halfBmpHeight,halfBmpWidth:Integer;
OldBmp:TBitmap;
XAdd,YAdd:Integer;
begin
OldBmp:=TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 halfBmpHeight:=OldBmp.Height div 2;
 halfBmpWidth:=OldBmp.Width div 2;
 if CircleCount=0 then CircleCount:=1;
 XAdd:=halfBmpWidth div CircleCount;
 YAdd:=halfBmpHeight div CircleCount;
 if XAdd=0 then XAdd:=1;
 if YAdd=0 then YAdd:=1;
 for i:=0 to CircleCount do
 begin
  Image.Canvas.CopyRect(Rect(halfBmpWidth-XAdd*i,halfBmpHeight-YAdd*i,
                             halfBmpWidth+XAdd*i,halfBmpHeight+YAdd*i),
                        OldBmp.Canvas,
                        Rect(halfBmpWidth-XAdd*i,halfBmpHeight-YAdd*i,
                             halfBmpWidth+XAdd*i,halfBmpHeight+YAdd*i));
  Image.Refresh;
  Sleep(SleepTime);
 end;
finally
 OldBmp.Free;
end;
end;


{ 从四周向中心逐渐显示图像特效
   输入参数:
     Image          要进行特效的TImage
     CircleCount    圈数
     SleepTime      特效的快慢控制
}
procedure Img_AllBorderToCenterExpand(Image:TImage;CircleCount,SleepTime:Word);
var
i,halfBmpHeight,halfBmpWidth:Integer;
OldBmp:TBitmap;
XAdd,YAdd:Integer;
begin
OldBmp:=TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 halfBmpHeight:=OldBmp.Height div 2;
 halfBmpWidth:=OldBmp.Width div 2;
 if CircleCount=0 then CircleCount:=1;
 XAdd:=halfBmpWidth div CircleCount;
 YAdd:=halfBmpHeight div CircleCount;
 if XAdd=0 then XAdd:=1;
 if YAdd=0 then YAdd:=1;
 Image.Canvas.Brush.Color:=clWhite;
 for i:=CircleCount downto 0 do
 begin
  Image.Canvas.CopyRect(Rect(0,0,OldBmp.Width,OldBmp.Height),
                        OldBmp.Canvas,
                        Rect(0,0,OldBmp.Width,OldBmp.Height));
  Image.Canvas.FillRect(Rect(halfBmpWidth-i*XAdd,halfBmpHeight-i*YAdd,
                             halfBmpWidth+i*XAdd,halfBmpHeight+i*YAdd));
  Image.Refresh;
  Sleep(SleepTime);
 end;
 Image.Canvas.CopyRect(Rect(0,0,OldBmp.Width,OldBmp.Height),
                       OldBmp.Canvas,
                       Rect(0,0,OldBmp.Width,OldBmp.Height));
finally
 OldBmp.Free;
end;
end;


{ 从单个顶点逐渐放大显示图像效果
   输入参数:
     Image        要进行特效的TImage
     CircleCount  圈数
     Direction    方向
     SleepTime    特效的快慢控制
}
procedure Img_SilVertexZoomIn(Image:TImage;Direction,CircleCount,SleepTime:Word);
var
OldBmp:TBItmap;
BmpWidth,BmpHeight:Integer;
i,AddX,AddY:Integer;
begin
OldBmp:=TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 BmpWidth:=OldBmp.Width;
 BmpHeight:=OldBmp.Height;
 if CircleCount=0 then CircleCount:=1;
 AddX:=BmpWidth div CircleCount;
 AddY:=BmpHeight div CircleCount;
 for i:=0 to CircleCount do
 begin
  case Direction of
   fromLeftTop :begin
                 Image.Canvas.CopyRect(Rect(0,0,i*AddX,i*AddY),
                                       OldBmp.Canvas,
                                       Rect(0,0,BmpWidth,BmpHeight));
                end;
   fromRightTop :begin
                  Image.Canvas.CopyRect(Rect(BmpWidth-i*AddX,0,BmpWidth,i*AddY),
                                        OldBmp.Canvas,
                                        Rect(0,0,BmpWidth,BmpHeight));
                 end;
   fromLeftBottom :begin
                    Image.Canvas.CopyRect(Rect(0,BmpHeight-i*AddY,i*AddX,BmpHeight),
                                          OldBmp.Canvas,
                                          Rect(0,0,BmpWidth,BmpHeight));
                   end;
   fromRightBottom :begin
                     Image.Canvas.CopyRect(Rect(BmpWidth-i*AddX,BmpHeight-i*AddY,
                                                BmpWidth,BmpHeight),
                                           OldBmp.Canvas,
                                           Rect(0,0,BmpWidth,BmpHeight));
                    end;   
  end;
  Image.Refresh;
  Sleep(SleepTime);
 end;
 Image.Canvas.CopyRect(Rect(0,0,BmpWidth,BmpHeight),
                       OldBmp.Canvas,
                       Rect(0,0,BmpWidth,BmpHeight));
finally
 OldBmp.Free;
end;
end;


{ 从单边逐渐放大显示图像效果
   输入参数:
     Image       要进行特效的TImage
     Direction   方向
     SleepTime   特效的快慢控制
}
procedure Img_SilBorderZoomIn(Image:TImage;Direction,SleepTime:Word);
var
OldBmp:TBItmap;
i,BmpWidth,BmpHeight:Integer;
begin
OldBmp:=TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 BmpWidth:=OldBmp.Width;
 BmpHeight:=OldBmp.Height;
 case Direction of
  fromBottomBorder :begin
                     for i:=0 to BmpHeight do
                     begin
                      Image.Canvas.CopyRect(Rect(0,BmpHeight-i,BmpWidth,BmpHeight),
                                            OldBmp.Canvas,
                                            Rect(0,0,BmpWidth,BmpHeight));
                      Image.Refresh;
                      Sleep(SleepTime);
                     end;
                    end;
  fromTopBorder :begin
                  for i:=0 to BmpHeight do
                  begin
                   Image.Canvas.CopyRect(Rect(0,0,BmpWidth,i),
                                         OldBmp.Canvas,
                                         Rect(0,0,BmpWidth,BmpHeight));
                   Image.Refresh;
                   Sleep(SleepTime);
                  end;
                 end;
  fromLeftBorder :begin
                   for i:=0 to BmpWidth do
                   begin
                    Image.Canvas.CopyRect(Rect(0,0,i,BmpHeight),
                                          OldBmp.Canvas,
                                          Rect(0,0,BmpWidth,BmpHeight));
                    Image.Refresh;
                    Sleep(SleepTime);
                   end;
                  end;
  fromRightBorder :begin
                    for i:=0 to BmpWidth do
                    begin
                     Image.Canvas.CopyRect(Rect(BmpWidth-i,0,BmpWidth,BmpHeight),
                                           OldBmp.Canvas,
                                           Rect(0,0,BmpWidth,BmpHeight));
                     Image.Refresh;
                     Sleep(SleepTime);
                    end;
                   end;
 end;
 Image.Canvas.CopyRect(Rect(0,0,BmpWidth,BmpHeight),
                       OldBmp.Canvas,
                       Rect(0,0,BmpWidth,BmpHeight));
finally
 OldBmp.Free;
end;
end;


{ 从中心向四周逐渐放大显示图像特效
   输入参数:
     Image          要进行特效的TImage
     CircleCount    扩散的圈数
     SleepTime      特效的快慢控制
}
procedure Img_CenterToAllBorderZoomIn(Image:TImage;CircleCount,SleepTime:Word);
var
i,halfBmpHeight,halfBmpWidth:Integer;
OldBmp:TBitmap;
XAdd,YAdd:Integer;
begin
OldBmp:=TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 halfBmpHeight:=OldBmp.Height div 2;
 halfBmpWidth:=OldBmp.Width div 2;
 if CircleCount=0 then CircleCount:=1;
 XAdd:=halfBmpWidth div CircleCount;
 YAdd:=halfBmpHeight div CircleCount;
 if XAdd=0 then XAdd:=1;
 if YAdd=0 then YAdd:=1;
 for i:=0 to CircleCount do
 begin
  Image.Canvas.CopyRect(Rect(halfBmpWidth-XAdd*i,halfBmpHeight-YAdd*i,
                             halfBmpWidth+XAdd*i,halfBmpHeight+YAdd*i),
                        OldBmp.Canvas,
                        Rect(0,0,OldBmp.Width,OldBmp.Height));
  Image.Refresh;
  Sleep(SleepTime);
 end;
 Image.Canvas.CopyRect(Rect(0,0,OldBmp.Width,OldBmp.Height),
                       OldBmp.Canvas,
                       Rect(0,0,OldBmp.Width,OldBmp.Height));

finally
 OldBmp.Free;
end;
end;


{ 从中间向对边逐渐放大显示图像
   输入参数:
     Image       要进行特效的TImage
     Direction   方向
     SleepTime   特效的快慢控制
}
procedure Img_CenterToDulBorderZoomIn(Image:TImage;Direction,SleepTime:Word);
var
i,BmpWidth,BmpHeight:Integer;
OldBmp:TBitmap;
Center:Integer;
begin
OldBmp:=TBitmap.Create;
try
 OldBmp.Assign(Image.Picture.Graphic);
 Image.Picture:=nil;
 BmpWidth:=OldBmp.Width;
 BmpHeight:=OldBmp.Height;
 case Direction of
  verticalShow :begin
                 Center:=BmpHeight div 2;
                 for i:=0 to Center do
                 begin
                  Image.Canvas.CopyRect(Rect(0,Center-i,BmpWidth,Center+i),
                                        OldBmp.Canvas,
                                        Rect(0,0,BmpWidth,BmpHeight));
                  Image.Refresh;
                  Sleep(SleepTime);
                 end;
                end;
  horizontalShow :begin
                   Center:=BmpWidth div 2;
                   for i:=0 to Center do
                   begin
                    Image.Canvas.CopyRect(Rect(Center-i,0,Center+i,BmpHeight),
                                          OldBmp.Canvas,
                                          Rect(0,0,BmpWidth,BmpHeight));
                    Image.Refresh;
                    Sleep(SleepTime);
                   end;
                  end;  
 end;
 Image.Canvas.CopyRect(Rect(0,0,BmpWidth,BmpHeight),
                       OldBmp.Canvas,
                       Rect(0,0,BmpWidth,BmpHeight));
finally
 OldBmp.Free;
end;
end; 



                                

查看回复