[原]DELPHI图像显示特效

前段一个项目需要对BMP图片进行显示，搭配不同的特效风格，显示的比较好看一点，在网上找了好些，但是代码都不全，自己总结了一下，现在发上来与大家分享，图像显示算法参考的DELPHI数字图像处理及高级应用这本书!

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls,Math,Jpeg;

type
  TfMain = class(TForm)
    Image1: TImage;
    pnl1: TPanel;
    btn1: TButton;
    tmr1: TTimer;
    procedure btn1Click(Sender: TObject);
    procedure tmr1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    State : Boolean;
    //百页窗效果
    procedure ShutterStyle;
    //图片从左到右显示
    procedure LeftToRight;
    //由上至下效果
    procedure UptoDown;
    //从中间往上下分开的效果
    procedure DownToUp;
    //从右向左显示
    procedure RightToLeft;
    //上拉滑入效果
    procedure SlideStyle;
    //淡入效果
    procedure FadeinStyle;
    //淡出效果
    procedure FAdeOutStyle;
    //淡入淡出效果的合并
    procedure fAdeInOutStyle;
    //马赛克效果
    procedure MosaicStyle;
    //垂直交错效果
    procedure VerticalCross;
    //水平交错效果
    procedure HorizCross;
    //图像中心渐出效果
    procedure CenterOut;
    //图像中心渐入效果
    procedure CenterIn;
    //水滴积木效果
    procedure WaterStyle;
    //图像的随机显示
    procedure RanDomStyle(iBz : Integer);
    { Public declarations }
  end;
var
  fMain: TfMain;
  InBmp : TBitmap;
implementation

{$R *.dfm}

{ TfMain }

procedure TfMain.btn1Click(Sender: TObject);
begin
  Randomize;
  tmr1.Enabled := True;
  if State then State := False
  else State := True;
end;

procedure TfMain.ShutterStyle;
var
  NewBmp : TBitMap;
  i,j,bmpHeight,bmpwidth : Integer;
  xGroup,xCount : Integer;
begin
  NewBmp    := TBitMap.Create;
  BmpWidth  := self.Image1.Width;
  BmpHeight := self.Image1.Height;
  NewBmP.Width := self.Image1.Width;
  NewBmP.Height := self.Image1.Height;
  Image1.Visible := False;
  xCount := 100;
  xGroup := BmpHeight div xCount;
  for i := 0 to Xgroup do
  begin
    for j := 0 to XCount do
    begin
      NewBmp.Canvas.CopyRect(Rect(0,j * xGroup + i -1,BmpWidth,j * xGroup+i),
            Image1.Canvas,Rect(0,j * xGroup + i - 1,bmpWidth,j * xGroup+i));
    end;
    Self.Canvas.Draw(0,0,NewBmp);
    Sleep(150);
    application.ProcessMessages;
  end;
  Image1.Visible := True;
  NewBmp.Free;
  self.Invalidate;
end;
procedure TfMain.CenterIn;
var
  newbmp:TBitmap;
  i,bmpheight,bmpwidth:integer;
  w,h:integer;
  rect1,rect2,rect3,rect4 : TRect;
Const
  Step = 40;
begin
  newbmp:= TBitmap.Create;
  newbmp.Width  := self.Width;
  newbmp.Height := self.Height;
  bmpheight     := self.Height;
  bmpwidth      := self.Width;
  w := bmpwidth div (2 * Step);
  h := bmpheight Div (2 * Step);
  Screen.Cursor := crHourGlass;
  for i := 0 to Step + 1 do
  begin
    rect1 := Rect(0,0,bmpwidth,h * i);
    rect2 := Rect(0,(bmpheight - h * i),bmpwidth,bmpheight);
    rect3 := Rect(0,i * h,i * w,(bmpheight - h  * i));
    rect4 := Rect((bmpwidth - i * w),i * h,bmpwidth,(bmpheight - i * h));
    NewBmp.Canvas.CopyRect(rect1,image1.Canvas,rect1);
    NewBmp.Canvas.CopyRect(rect2,image1.Canvas,rect2);
    NewBmp.Canvas.CopyRect(rect3,image1.Canvas,rect3);
    NewBmp.Canvas.CopyRect(rect4,image1.Canvas,rect4);
    self.Canvas.Draw(Image1.Left,Image1.Top,NewBmp);
    Sleep(50);
  end;
  newbmp.Free;
  Screen.Cursor := crDefault;
  self.Invalidate;
end;

procedure TfMain.CenterOut;
var
  newbmp:TBitmap;
  i,bmpheight,bmpwidth:integer;
  w,h:integer;
Const
  Step = 40;
begin
  newbmp:= TBitmap.Create;
  newbmp.Width  := self.Width;
  newbmp.Height := self.Height;
  bmpheight     := self.Height;
  bmpwidth      := self.Width;
  w := bmpwidth div (2 * Step);
  h := bmpheight Div (2 * Step);
  Screen.Cursor := crHourGlass;
  for i := 0 to (Step + 1) do
  begin
    NewBmp.Canvas.CopyRect(Rect(w * (Step - 1 - i),h * ( Step - 1 - i),
      w * (Step  - 1 + i),h * (Step  - 1 + i)),Image1.Canvas,Rect(w * (Step - 1 - i),
      h * (Step - 1 - i),w  * ( Step - 1 + i),h * (Step - 1 + i)));
    self.Canvas.Draw(Image1.Left,Image1.Top,NewBmp);
    Sleep(40);
  end;
  newbmp.Free;
  Screen.Cursor := crDefault;
  application.ProcessMessages;
  self.Invalidate;
end;

procedure TfMain.DownToUp;
var
  newbmp:TBitmap;
  i,j,bmpheight,bmpwidth:integer;
  xgroup,xcount:integer;
begin
  newbmp:= TBitmap.Create;
  newbmp.Width  := Image1.Width;
  newbmp.Height := Image1.Height;
  bmpheight     := Image1.Height;
  bmpwidth      := Image1.Width;
  xgroup := 1;
  xcount:=bmpheight div xgroup;
  xcount:=xcount div 2;
  for i:=0 to xcount  do
      for j:=0 to xgroup do
      begin
        newbmp.Canvas.CopyRect(Rect(0,(bmpheight div 2)-i,bmpwidth,bmpheight div 2),
                image1.Canvas,Rect(0,(bmpheight div 2)-i,bmpwidth,bmpheight div 2));
        self.Canvas.Draw(0,0,newbmp); //从上向下填充

        newbmp.Canvas.CopyRect(Rect(0,(bmpheight div 2),bmpwidth,(bmpheight div 2)+i),
                image1.Canvas,Rect(0,(bmpheight div 2),bmpwidth,(bmpheight div 2)+i));
        self.Canvas.Draw(0,0,newbmp); //从下向上填充
     
        Application.ProcessMessages;
      end;
  newbmp.Free;
  self.Invalidate;
end;

procedure TfMain.fAdeInOutStyle;
begin
  FadeinStyle;
  FAdeOutStyle;
end;

procedure TfMain.FadeinStyle;
var
  NewBmp: TBitMap;
  x,y,k : Integer;
  T : pByteArray;
Const
  Step = 60;
begin
  NewBmp := TBitMap.Create;
  InBmp  := TBitMap.Create;
  InBmp.Width  := Self.Image1.Width;
  InBmp.Height := self.Image1.Height;
  NewBmp.Width  := Self.Image1.Width;
  NewBmp.Height := self.Image1.Height;
  NewBmp.Assign(Image1.Picture.Bitmap);
  for k := 0 to Step do
  begin
    for x := 0 to NewBmp.Height - 1 do
    begin
      T := NewBmp.ScanLine[x];
      for y := 0 to NewBmp.Width - 1 do
      begin
         T[3*y+2] := Max(0,Min(255,T[3*y+2]-2));
         T[3*y+1] := Max(0,Min(255,T[3*y+1]-2));
         T[3*y] := Max(0,Min(255,T[3*y]-2));
      end;
    end;
    Self.Canvas.Draw(0,0,NewBmp);
    Sleep(5);
  end;
  InBmp.Assign(NewBmp);
//  Self.Invalidate;
  NewBmp.Free;
  self.Invalidate;
end;

procedure TfMain.FAdeOutStyle;
var
  NewBmp,BitBmp: TBitMap;
  x,y,k : Integer;
  T,P : pByteArray;
Const
  Step = 60;
begin
  NewBmp := TBitMap.Create;
  NewBmp.Width  := Self.Image1.Width;
  NewBmp.Height := self.Image1.Height;
  NewBmp.Assign(Image1.Picture.Bitmap);
  BitBmp := TBitMap.Create;
  BitBmp.Width  := Self.Image1.Width;
  BitBmp.Height := self.Image1.Height;
  BitBmp.Assign(Image1.Picture.Bitmap);
  NewBmp.Assign(InBmp);
//  BitBmp.Assign(OriginalBmp);
  for k := 0 to Step do
  begin
    for x := 0 to NewBmp.Height - 1 do
    begin
      T := NewBmp.ScanLine[x];
      P := BitBmp.ScanLine[x];
      for y := 0 to NewBmp.Width - 1 do
      begin
        if T[3*Y] < P[3*Y] then
           T[3*Y] := Max(0,Min(255,T[3*Y]+2))
        else
          T[3*Y] := P[3*Y];
        if T[3*Y+1] < P[3*Y+1] then
           T[3*Y+1] := Max(0,Min(255,T[3*Y+1]+1))
        else
          T[3*Y+1] := P[3*Y+1];
        if T[3*Y+2] < P[3*Y+2] then
           T[3*Y+2] := Max(0,Min(255,T[3*Y+2]+1))
        else
          T[3*Y+2] := P[3*Y+2];
      end;
    end;
    self.Canvas.Draw(Image1.Left,Image1.Top,NewBmp);
    Sleep(5);
  end;
  NewBmp.free;
  self.Invalidate;
end;

procedure TfMain.HorizCross;
var
  NewBmp : tBitMap;
  i,j,BmpHeight,BmpWidth : Integer;
begin
  NewBmp := tBitMap.Create;
  NewBmp.Width  := Self.Image1.Width;
  NewBmp.Height := self.Image1.Height;
  BmpHeight     := Self.Image1.Height;
  BmpWidth      := Self.image1.Width;
  i := 0;
  NewBmp.Canvas.Brush.Color := clGray;
  NewBmp.Canvas.Brush.Style := bsSolid;
  NewBmp.Canvas.FillRect(RECT(0,0,BmpWidth,BmpHeight));
  while i <= BmpWidth do
  begin
    j := i;
    while j > 0 do
    begin
      NewBmp.Canvas.CopyRect(Rect(j-1,0,j,BmpHeight),
        self.Image1.Canvas,Rect(BmpWidth- i +j-1,0,BmpWidth - i + j,
        BmpHeight));
      NewBmp.Canvas.CopyRect(Rect(BmpWidth-j,0,
        BmpWidth - j + 1,BmpHeight),Self.Image1.Canvas,
        Rect(i-j,0,i - j + 1,BmpHeight));
      j := j - 2;   
    end;
    self.Image1.Top := self.Height div 2 - self.Image1.Picture.Graphic.Height div 2;
    self.image1.Left := self.Width div 2 - self.image1.Picture.Graphic.Width div 2;
    self.Canvas.Draw(self.image1.Left,self.Image1.Top,NewBmp);
    i := i + 2;
  end;
  NewBmp.Free;
  self.Invalidate;
end;

procedure TfMain.LeftToRight;
var
  NewBmp : tBitMap;
  i,BmpHeight,BmpWidth : Integer;
begin
  NewBmp := TBitMap.Create;
  NewBmp.Width  := Self.Image1.Width;
  NewBmp.Height := self.Image1.Height;
  BmpHeight     := Self.Image1.Height;
  BmpWidth      := Self.image1.Width;
  NewBmp.Canvas.Brush.Color := clGray;
  NewBmp.Canvas.Brush.Style := bsSolid;
  NewBmp.Canvas.FillRect(RECT(0,0,BmpWidth,BmpHeight));
  for i := 0 to BmpWidth do
  begin
    NewBmp.Canvas.CopyRect(Rect(i,0,i+1,BmpHeight),
      self.Image1.Canvas,Rect(i,0,i+1,BmpHeight));
    Self.Canvas.Draw(Self.Image1.Left,Self.Image1.Top,NewBmp);
    Application.ProcessMessages;
  end;
  Self.Invalidate;
  NewBmp.Free;
end;

procedure TfMain.MosaicStyle;
var
  NewBmp : TBitmap;
  i,BmpHeight,BmpWidth : Integer;
  x,y : Integer;
Const
  Squ = 50 ;
begin
  Newbmp := tBitMap.Create;
  NewBmP.Width  := Self.Width;
  NewBmP.Height := Self.Height;
  bmpHeight := Self.Height;
  bmpwidth  := Self.Width;
  Image1.Visible := False;
  Randomize;
  for i := 0 to 2500 do
  begin
    x := Random(BmpWidth div Squ);
    y := Random(BmpHeight div Squ);
    NewBmp.Canvas.CopyRect(Rect(x * Squ,y * Squ,(x+1)*Squ,(y
     +1)*Squ),Image1.Canvas,
     Rect(x * Squ,y * Squ,(x+1)*Squ,(y+1)*Squ));
     self.Canvas.Draw(0,32,NewBmp);
    Application.ProcessMessages;
  end;
  NewBmp.Canvas.CopyRect(Rect(0,0,BmpWidth,BmpHeight),Image1.Canvas,
  Rect(0,0,BmpWidth,BmpHeight));
  self.Canvas.Draw(256,32,NewBmp);
  Image1.Visible := True;
  NewBmp.Free;
  self.Invalidate;
end;

procedure TfMain.RanDomStyle(iBz: Integer);
begin
  case iBz of
    0  : ShutterStyle;
    1  : LeftToRight;
    2  : UptoDown;
    3  : WaterStyle;
    4  : CenterIn;
    5  : CenterOut;
    6  : HorizCross;
    7  : VerticalCross;
    8  : MosaicStyle;
//    9  : ScatterStyle;
    10 : fAdeInOutStyle;
    11 : SlideStyle;
    12 : RightToLeft;
    13 : DownToUp;
  end;
end;

procedure TfMain.RightToLeft;
var
  NewBmp : TBitMap;
  i,bmpHeight,bmpwidth : Integer;
begin
  //创建TBitMap对象NewBmp
  Newbmp := tBitMap.Create;
  NewBmP.Width  := Self.Width;
  NewBmP.Height := Self.Height;
  bmpHeight := Self.Height;
  bmpwidth  := Self.Width;
  newbmp.canvas.Brush.Color := Clgray;
  newbmp.canvas.Brush.Style := bsSolid;
  newbmp.Canvas.FillRect(rect(0,0,bmpwidth,bmpheight));
  for i := 0 to bmpWidth do
  begin
    newbmp.canvas.CopyRect(rect(bmpwidth-1-i,0,bmpwidth-i,bmpHeight),
    image1.canvas,rect(bmpwidth-1-i,0,bmpwidth-i,bmpHeight));
    self.canvas.draw(Self.image1.Left,self.image1.Top,NewBmp);
    Application.ProcessMessages;
  end;
  self.Invalidate;
  newbmp.free;
end;

procedure TfMain.SlideStyle;
var
  NewBmp : TBitMap;
  i,bmpHeight,bmpwidth : Integer;
begin
  //创建TBitMap对象NewBmp
  Newbmp := tBitMap.Create;
  NewBmP.Width  := Self.Width;
  NewBmP.Height := Self.Height;
  bmpHeight := Self.Height;
  bmpwidth  := Self.Width;
  newbmp.canvas.Brush.Color := Clgray;
  newbmp.canvas.Brush.Style := bsSolid;
  newbmp.Canvas.FillRect(rect(0,0,bmpwidth,bmpheight));
  for i := 0 to bmpheight do
  begin
    newbmp.canvas.CopyRect(rect(0,0,i,bmpHeight),
    image1.canvas,rect(0,0,bmpHeight-i-1,bmpHeight-1));
    self.canvas.draw(Self.image1.Left,self.image1.Top,NewBmp);
    Application.ProcessMessages;
  end;
  self.Invalidate;
  newbmp.free;
end;

procedure TfMain.tmr1Timer(Sender: TObject);
var
  RanNum : Integer;
begin
  tmr1.Enabled := false;
  RanNum := Random(14);
  RanDomStyle(RanNum);
  if State then Exit;
  tmr1.Enabled := True;
end;

procedure TfMain.UptoDown;
var
  NewBmp : TBitMap;
  i,bmpHeight,bmpwidth : Integer;
begin
  //创建TBitMap对象NewBmp
  Newbmp := tBitMap.Create;
  NewBmP.Width  := Self.Width;
  NewBmP.Height := Self.Height;
  bmpHeight := Self.Height;
  bmpwidth  := Self.Width;
  newbmp.canvas.Brush.Color := Clgray;
  newbmp.canvas.Brush.Style := bsSolid;
  newbmp.Canvas.FillRect(rect(0,0,bmpwidth,bmpheight));
  for i := 0 to bmpheight do
  begin
    newbmp.canvas.CopyRect(rect(0,i,bmpwidth,i+1),
    image1.canvas,rect(0,i,bmpwidth,i+1));
    self.canvas.draw(Self.image1.Left,self.image1.Top,NewBmp);
    Application.ProcessMessages;
  end;
  self.Invalidate;
  newbmp.free;
end;

procedure TfMain.VerticalCross;
var
  NewBmp : TBitmap;
  i,j,BmpHeight,BmpWidth : Integer;
begin
  NewBmp := TBitMap.Create;
  NewBmP.Width  := Self.Width;
  NewBmP.Height := Self.Height;
  bmpHeight := Self.Height;
  bmpwidth  := Self.Width;
  i := 0;
  newbmp.canvas.Brush.Color := Clgray;
  newbmp.canvas.Brush.Style := bsSolid;
  newbmp.Canvas.FillRect(rect(0,0,bmpwidth,bmpheight));
  while i <= BmpHeight do
  begin
    j := i;
    while j > 0 do
    begin
      NewBmp.Canvas.CopyRect(Rect(0,j- 1,BmpWidth,j),
        self.Image1.Canvas,Rect(0,BmpHeight- i +j-1,BmpWidth,
        BmpHeight - i + j));
      NewBmp.Canvas.CopyRect(Rect(0,BmpHeight-j,
        BmpWidth,BmpHeight - j + 1),Self.Image1.Canvas,
        Rect(0,i-j,BmpWidth,i - j + 1));
      j := j - 2;
   end;
    self.Image1.Top := self.Height div 2 - self.Image1.Picture.Graphic.Height div 2;
    self.image1.Left := self.Width div 2 - self.image1.Picture.Graphic.Width div 2;
    self.Canvas.Draw(self.image1.Left,self.image1.Top,NewBmp);
    i := i + 2;
  end;
  self.DoubleBuffered := True;
  self.Invalidate;
  NewBmp.Free;
end;

procedure TfMain.WaterStyle;
var
  NewBmp : TBitMap;
  i,j,bmpHeight,BmpWidth : Integer;
begin
  NewBmp := TBitMap.Create;
  NewBmp.Width := Image1.Width;
  NewBmp.Height := Image1.Height;
  bmpHeight  := image1.Height;
  BmpWidth   := Image1.Width;
  i := bmpHeight;
  Image1.Visible := False;
//  Screen.Cursor := crHourGlass;
  while i > 0 do
  begin
    for j := 50 to i do
    begin
      newbmp.Canvas.CopyRect(Rect(0,j - 50,BmpWidth,j),
        image1.Canvas,Rect(0,i - 50,BmpWidth,i));
      if (j - 50 ) > 0 then
      begin
        NewBmp.Canvas.Brush.Color := clWhite;
        NewBmp.Canvas.FillRect(Rect(0,j - 51 ,BmpWidth,j- 50));
      end;
      self.Canvas.Draw(0,0,NewBmp);
    end;
    i := i - 50;
  end;
  NewBmp.Free;
//  Screen.Cursor := crDefault;
  image1.Visible := True;
  self.Invalidate;
end;

end.