main.~pas

源码Delphi图像特效显示V1.0版

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ComCtrls, StdCtrls,ExtCtrls, shellapi,ExtDlgs;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    D1: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    N28: TMenuItem;
    N29: TMenuItem;
    N30: TMenuItem;
    N31: TMenuItem;
    N32: TMenuItem;
    N33: TMenuItem;
    N34: TMenuItem;
    N2: TMenuItem;
    N35: TMenuItem;
    N36: TMenuItem;
    N37: TMenuItem;
    N38: TMenuItem;
    N39: TMenuItem;
    N40: TMenuItem;
    N41: TMenuItem;
    N42: TMenuItem;
    N43: TMenuItem;
    N44: TMenuItem;
    N45: TMenuItem;
    N46: TMenuItem;
    N47: TMenuItem;
    N48: TMenuItem;
    H1: TMenuItem;
    N3: TMenuItem;
    StatusBar1: TStatusBar;
    OpenPictureDialog1: TOpenPictureDialog;
    Image1: TImage;
    PaintBox1: TPaintBox;
    N49: TMenuItem;
    procedure N4Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N34Click(Sender: TObject);
    procedure N33Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N22Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N29Click(Sender: TObject);
    procedure N32Click(Sender: TObject);
    procedure N35Click(Sender: TObject);
    procedure N36Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N37Click(Sender: TObject);
    procedure N27Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure N9Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure N31Click(Sender: TObject);
    procedure N16Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N14Click(Sender: TObject);
    procedure N30Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure N18Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N49Click(Sender: TObject);
    procedure N42Click(Sender: TObject);
    procedure N40Click(Sender: TObject);
    procedure N41Click(Sender: TObject);
    procedure N38Click(Sender: TObject);
    procedure N44Click(Sender: TObject);
    procedure N45Click(Sender: TObject);
    procedure N46Click(Sender: TObject);
    procedure N47Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  hdc1,hdc2:hdc;
  k:integer;
  w,h,i,j:integer;
 // bitmap:tbitmap;
  rect1,rect2,rect3:trect;

implementation

uses about;

{$R *.DFM}

procedure TForm1.N4Click(Sender: TObject);
begin
  if OpenPictureDialog1.Execute then
  begin
  n7.Enabled:=true;
  n12.Enabled:=true;
  n17.Enabled:=true;
  n20.Enabled:=true;
  n23.Enabled:=true;
  n28.Enabled:=true;
  n31.Enabled:=true;
  n32.Enabled:=true;
  n33.Enabled:=true;
  n34.Enabled:=true;
  n35.Enabled:=true;
  n36.Enabled:=true;
  n37.Enabled:=true;
  n38.Enabled:=true;
  n39.Enabled:=true;
  n42.Enabled:=true;
  n43.Enabled:=true;
  n48.Enabled:=true;
 image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
 image1.Visible:=true;
form1.Repaint;
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  n7.Enabled:=false;
  n12.Enabled:=false;
  n17.Enabled:=false;
  n20.Enabled:=false;
  n23.Enabled:=false;
  n28.Enabled:=false;
  n31.Enabled:=false;
  n32.Enabled:=false;
  n33.Enabled:=false;
  n34.Enabled:=false;
  n35.Enabled:=false;
  n36.Enabled:=false;
  n37.Enabled:=false;
  n38.Enabled:=false;
  n39.Enabled:=false;
  n42.Enabled:=false;
  n43.Enabled:=false;
  n48.Enabled:=false;
end;

procedure TForm1.N6Click(Sender: TObject);
begin
 if messagedlg('程序即将结束,是否确认?',mtconfirmation,[mbyes,mbno],0)=mryes
 then
 application.Terminate;
end;

procedure TForm1.N34Click(Sender: TObject);
var
newbmp1:Tbitmap;
i1,j1,bmpheight1,bmpwidth1:integer;
begin
image1.Visible:=true;
form1.Repaint;
newbmp1:=tbitmap.Create;
newbmp1.Width:=Image1.Width;
newbmp1.Height:=Image1.Height;
bmpheight1:=Image1.Height;
bmpwidth1:=Image1.Width;
for i1:=bmpheight1 downto 1 do
 for j1:=1 to i1 do
   begin
     newbmp1.Canvas.CopyRect(rect(0,j1-1,bmpwidth1,j1),image1.canvas,rect(0,i1-1,bmpwidth1,i1));
     Canvas.Draw(395,109,newbmp1);
   end;
newbmp1.Free;
end;

procedure TForm1.N33Click(Sender: TObject);
var
newbmp:Tbitmap;
i,j,bmpheight,bmpwidth:integer;
begin
image1.Visible:=true;
form1.Repaint;
newbmp:=tbitmap.Create;
newbmp.Width:=Image1.Width;
newbmp.Height:=Image1.Height;
bmpheight:=Image1.Height;
bmpwidth:=Image1.Width;
i:=bmpheight;
while i >0 do
begin
for j:=10 to i do
begin
 newbmp.Canvas.CopyRect(Rect(0,i-20,bmpwidth,j),
                        image1.Canvas,
                        Rect(0,i-20,bmpwidth,i));
 Canvas.Draw(395,109,newbmp);
end;
i:=i-20;
end;
newbmp.free;
end;

procedure TForm1.N21Click(Sender: TObject);
var
 newbmp:TBitmap;
 i,j,bmpheight,bmpwidth:integer;
 xgroup,xcount:integer;
begin
image1.Visible:=true;
form1.Repaint;
image1.Visible:=true;
form1.Repaint;
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
xgroup:=16;
xcount:=bmpheight div xgroup;
for i:=0  to xcount do
for j:=0 to xgroup do
begin
 newbmp.Canvas.CopyRect(Rect(0,xcount*j+i-1,bmpwidth,xcount*j+i),
                        image1.Canvas,
                        Rect(0,xcount*j+i-1,bmpwidth,xcount*j+i));
 Canvas.Draw(395,109,newbmp);
end;
newbmp.Free;
end;

procedure TForm1.N22Click(Sender: TObject);
var
 newbmp:TBitmap;
 i,j,bmpheight,bmpwidth:integer;
 xgroup,xcount:integer;
begin
image1.Visible:=true;
form1.Repaint;
newbmp:= TBitmap.Create;
newbmp.Width:=image1.Width;
newbmp.Height:=image1.Height;
bmpheight:=image1.Height;
bmpwidth:=image1.Width;
xgroup:=16;
xcount:=bmpwidth div xgroup;
for i:=0  to xcount do
for j:=0 to xgroup do
begin
 newbmp.Canvas.CopyRect(Rect(xcount*j+i-1,0,xcount*j+i,bmpheight),
                        image1.Canvas,
                        Rect(xcount*j+i-1,0,xcount*j+i,bmpheight));
 Canvas.Draw(395,109,newbmp);
end;
newbmp.Free;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  w:=image1.width;
  h:=image1.Height;
end;

procedure TForm1.N15Click(Sender: TObject);
var i:integer;
begin
image1.Visible:=true;
form1.Repaint;
  k:=0;
  paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  while k<101 do
  begin
    for i:=w downto 0 do
    begin
      bitblt(hdc2,(i*k) div 100,0,1,h,hdc1,i,0,srccopy);
    end;
    k:=k+1;
  end;
end;

procedure TForm1.N29Click(Sender: TObject);
var
  i,j:integer;
begin
image1.Visible:=true;
form1.Repaint;
  paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  for i:=0 to w do
  begin
    for j:=0 to 1 do
    begin
      bitblt(hdc2,0,0,i,h div 4,hdc1,w-i,0,srccopy);
      bitblt(hdc2,w-i,h div 4,i,h div 4,hdc1,0,h div 4,srccopy);
      bitblt(hdc2,0,h div 2,i,h div 4,hdc1,w-i,h div 2,srccopy);
      bitblt(hdc2,w-i,3*h div 4,i,h div 4,hdc1,0,3*h div 4,srccopy);
      sleep(5);
    end;
  end;
end;

procedure TForm1.N32Click(Sender: TObject);
var
  i,j:integer;
begin
image1.Visible:=true;
form1.Repaint;
  paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  for i:=0 to (w div 3) do
  begin
    for j:=0 to 1 do
    begin
     bitblt(hdc2,0,0,i,i,hdc1,w div 3-i,h div 3-i,srccopy);
     bitblt(hdc2,w div 3,0,w div 3,i,hdc1,w div 3,h div 3-i,srccopy);
     bitblt(hdc2,w-i,0,i,i,hdc1,2*w div 3,h div 3-i,srccopy);
     bitblt(hdc2,0,h div 3,i,h div 3,hdc1,w div 3-i,h div 3,srccopy);
     bitblt(hdc2,w-i,h div 3,i,h div 3,hdc1,2*w div 3,h div 3,srccopy);
     bitblt(hdc2,0,h-i,i,h div 3,hdc1,w div 3-i,2*h div 3,srccopy);
     bitblt(hdc2,w div 3,h-i,w div 3,h-i,hdc1,w div 3,2*h div 3,srccopy);
     bitblt(hdc2,w-i,h-i,i,i,hdc1,2*w div 3,2*h div 3,srccopy);
     bitblt(hdc2,w div 2-i div 2,h div 2-i div 2,i,i,hdc1,w div 2-i div 2,h div 2-i div 2,srccopy);
     sleep(20);
    end;
  end;
end;

procedure TForm1.N35Click(Sender: TObject);
begin
image1.Visible:=true;
form1.Repaint;
 paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  bitblt(hdc2,0,0,w,h,hdc1,0,0,srcand);
end;

procedure TForm1.N36Click(Sender: TObject);
begin
image1.Visible:=true;
form1.Repaint;
  paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  bitblt(hdc2,0,0,w,h,hdc1,0,0,srcpaint);
end;

procedure TForm1.N19Click(Sender: TObject);
var i:integer;
begin
image1.Visible:=true;
form1.Repaint;
  paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  for i:=0 to (w div 2)+1 do
  begin
    bitblt(hdc2,i,0,1,h,hdc1,i,0,srccopy);
    bitblt(hdc2,w-i,0,w,h,hdc1,w-i,0,srccopy);
    sleep(10);
  end;
end;

procedure TForm1.N37Click(Sender: TObject);
begin
image1.Visible:=true;
form1.Repaint;
  paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  bitblt(hdc2,0,0,w,h,hdc1,0,0,notsrccopy);
end;

procedure TForm1.N27Click(Sender: TObject);
var i:integer;
begin
image1.Visible:=true;
form1.Repaint;
  paintbox1.Refresh();
  hdc2:=paintbox1.Canvas.Handle;
  hdc1:=image1.Canvas.Handle;
  for i:=0 to w do
  begin
    bitblt(hdc2,w-i,0,i,h,hdc1,w-i,0,srccopy);
    sleep(10);
  end;
end;

procedure TForm1.N8Click(Sender: TObject);
var
   newbmp: TBitmap;
   i,bmpheight,bmpwidth:integer;