unitfrmmain.pas

《Delphi实用程序100例》配套书源码盘

unit unitFrmMain;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Image1: TImage;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);


  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(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.Button2Click(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;

end.