show.pas

有关多媒体的各个细节

unit Show;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls;
const StepNum=5;
type
  TForm1 = class(TForm)
    SourceImage: TImage;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    BufferImage: TImage;
    ShowImage: TImage;
    Button1: TButton;
    Button2: TButton;
    procedure Button7Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
   procedure SpecificShowImage(ShowImage:TImage;FileName:String;ShowMode:Integer);
  end;

var
  Form1: TForm1;

implementation

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

procedure TForm1.SpecificShowImage(ShowImage:TImage;FileName:String;ShowMode:Integer);
var
 i,j,BmpHeight,BmpWidth,xgroup,xcount:Integer;
begin
 SourceImage.Picture.LoadFromFile(FileName);
 BufferImage.Width:=SourceImage.Picture.Width;
 BufferImage.Height:=SourceImage.Picture.Height;
 bmpheight:=SourceImage.Picture.Height;
 bmpwidth:=SourceImage.Picture.Width;
 BufferImage.Canvas.brush.color:=clBlack;
 BufferImage.Canvas.FillRect(Rect(0,0,BufferImage.Width,BufferImage.Height));
 case showMode of
   0://无效果
     begin
      ShowImage.Canvas.Draw(0,0,SourceImage.Picture.Bitmap);
     end;
  1: //推拉
     begin
      i:=0;
      while i<=bmpheight do
       begin
        BufferImage.Canvas.CopyRect(Rect(0,bmpheight-i,bmpwidth,bmpheight),SourceImage.Canvas
         ,Rect(0,0,bmpwidth,i));
        ShowImage.Canvas.Draw(0,0,BufferImage.Picture.Bitmap);
        Application.ProcessMessages;
       i:=i+1;
       end;
     end;
   2: //垂直
     begin
      i:=0;
      while i<=bmpheight do
       begin
        j:=i;
        while j>0 do
         begin
          BufferImage.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),SourceImage.Canvas
         ,Rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j));

          BufferImage.Canvas.CopyRect(Rect(0,bmpheight-j,bmpwidth,bmpheight-j+1),SourceImage.Canvas
         ,Rect(0,i-j,bmpwidth,i-j+1));
          j:=j-2;
         end;
        ShowImage.Canvas.Draw(0,0,BufferImage.Picture.Bitmap);
        i:=i+1;
        Application.ProcessMessages;
       end;
     end;
   3://水平
     begin
      i:=0;
      while i<=bmpwidth do
       begin
        j:=i;
        while j>0 do
         begin
          BufferImage.Canvas.CopyRect(Rect(j-1,0,j,bmpHeight),Sourceimage.Canvas
         ,Rect(bmpWidth-i+j-1,0,bmpWidth-i+j,bmpHeight));

          BufferImage.Canvas.CopyRect(Rect(bmpWidth-j,0,bmpWidth-j+1,BmpHeight),Sourceimage.Canvas
         ,Rect(i-j,0,i-j+1,bmpHeight));
          j:=j-2;
         end;
        ShowImage.Canvas.Draw(0,0,BufferImage.Picture.Bitmap);
        i:=i+4;
        Application.ProcessMessages;
       end;
      ShowImage.Canvas.Draw(0,0,SourceImage.Picture.Bitmap);
     end;
   6://雨滴
     begin
      i:=bmpheight;
      while i>0 do
       begin
        j:=1;
        while j<i do
         begin
          BufferImage.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),Sourceimage.Canvas
          ,Rect(0,i-1,bmpwidth,i));
          ShowImage.Canvas.Draw(0,0,BufferImage.Picture.Bitmap);
          Application.ProcessMessages;
          j:=j+1;
         end;
        i:=i-1;
       end;
     end;
    4://百页窗
      begin
       xgroup:=8;
       xcount:=bmpheight div xgroup;
       BufferImage.Canvas.brush.color:=clWhite;
       BufferImage.Canvas.FillRect(Rect(0,0,BufferImage.Width,BufferImage.Height));
       for i:=0 to xcount do
        for j:=0 to xgroup do
         begin
          BufferImage.Canvas.CopyRect(Rect(0,xcount*j+i-StepNum,bmpwidth,xcount*j+i),
          SourceImage.Canvas,Rect(0,xcount*j+i-StepNum,bmpwidth,xcount*j+i));
          ShowImage.Canvas.Draw(0,0,BufferImage.Picture.Bitmap);
         Application.ProcessMessages;
        end;
      end;
    5://积木式
      begin
       i:=bmpheight;
       while i>0 do
        begin
         j:=0;
         while j<=i do
          begin
           BufferImage.Canvas.CopyRect(Rect(0,j-StepNum,bmpwidth,j),
           Sourceimage.Canvas,Rect(0,i-StepNum,bmpwidth,i));
           ShowImage.Canvas.Draw(0,0,BufferImage.Picture.Bitmap);
           Application.ProcessMessages;
           j:=j+StepNum;
          end;
         i:=i-StepNum;
        end;
      end;
 end;
end;

//雨滴
procedure TForm1.Button4Click(Sender: TObject);
begin
 SpecificShowImage(ShowImage,'test.bmp',4);
end;
//百页窗式
procedure TForm1.Button5Click(Sender: TObject);
begin
 SpecificShowImage(ShowImage,'test.bmp',5);
end;

//积木式
procedure TForm1.Button6Click(Sender: TObject);
begin
 SpecificShowImage(ShowImage,'test.bmp',6);
end;

//水平
procedure TForm1.Button3Click(Sender: TObject);
begin
 SpecificShowImage(ShowImage,'test.bmp',3);
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
 SpecificShowImage(ShowImage,'test.bmp',1);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 SpecificShowImage(ShowImage,'test.bmp',2);
end;

end.