⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 图形显示技巧,这是其中一段代码 procedure TForm1.Button1Click(Sender: TObject) var newbmp:TBitmap i,bmphei
💻 PAS
字号:
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var
 newbmp:TBitmap;
 i,bmpheight,bmpwidth:integer;            //推拉
 begin
  newbmp:=TBitmap.Create;
  newbmp.Width:=image1.Width;
  newbmp.Height:=image1.Height;
  bmpheight:=image1.Height;
  bmpwidth:=image1.Width;
    for i:=0 to bmpheight do
     begin
       newbmp.Canvas.CopyRect(Rect(0,bmpheight-i,bmpwidth,bmpheight),image1.Canvas,Rect(0,0,bmpwidth,i));
       form1.Canvas.Draw(120,100,newbmp);
     end;
  newbmp.free;
end;

procedure TForm1.Button2Click(Sender: TObject);      //垂直交错
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:=0;
     while i<=bmpheight do
       begin
         j:=i;
         while j>0 do
          begin
           newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),image1.Canvas,Rect(0,bmpheight-i+j-1,bmpwidth,bmpheight-i+j));
           newbmp.Canvas.CopyRect(Rect(0,bmpheight-j,bmpwidth,bmpheight-j+1), image1.Canvas,Rect(0,i-j,bmpwidth,i-j+1));
           j:=j-1;
          end;
     form1.Canvas.Draw(120,100,newbmp);
       i:=i+1;
     end;
     newbmp.free;
end;

procedure TForm1.Button3Click(Sender: TObject);
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:=0;
  while i<=bmpwidth do
     begin
      j:=i;
       while j>0 do
       begin
          newbmp.Canvas.CopyRect(Rect(j-1,0,j,bmpheight), image1.Canvas, Rect(bmpwidth-i+j-1,0,bmpwidth-i+j,bmpheight));
          newbmp.Canvas.CopyRect(Rect(bmpwidth-j,0,bmpwidth-j+1,bmpheight), image1.Canvas, Rect(i-j,0,i-j+1,bmpheight));
          j:=j-2;
       end;
     form1.Canvas.Draw(120,100,newbmp);
     i:=i+2;
     end;

end;

procedure TForm1.Button4Click(Sender: TObject); //瀑布
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;               
  for i:=bmpheight downto 1 do
    for j:=1 to i do
      begin
        newbmp.Canvas.CopyRect(Rect(0,j-1,bmpwidth,j),image1.Canvas, Rect(0,i-1,bmpwidth,i));
        form1.Canvas.Draw(120,100,newbmp);
      end;
   newbmp.free;
end;

procedure TForm1.Button5Click(Sender: TObject);          //百叶窗
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:=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));
       form1.Canvas.Draw(120,100,newbmp);
     end;
   newbmp.Free;
end;

procedure TForm1.Button6Click(Sender: TObject);       //积木
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;
  while i>0 do
    begin
    for j:=10 to i do
     begin
       newbmp.Canvas.CopyRect(Rect(0,j-10,bmpwidth,j), image1.Canvas, Rect(0,i-10,bmpwidth,i));
       form1.Canvas.Draw(120,100,newbmp);
     end;
  i:=i-10; 
  end;
newbmp.free;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -