svn/view/Unit1.pas

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtDlgs, Vcl.StdCtrls, Vcl.ExtCtrls,
  Vcl.ComCtrls, Vcl.Imaging.pngImage;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    OpenPictureDialog1: TOpenPictureDialog;
    Edit1: TEdit;
    UpDown1: TUpDown;
    Label1: TLabel;
    Button2: TButton;
    Label2: TLabel;
    Button3: TButton;
    SavePictureDialog1: TSavePictureDialog;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
      NewValue: Integer; Direction: TUpDownDirection);
  private
    procedure Execute(aCount: integer);
    { Private éž }
  public
    { Public éž }
    List: TList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  s: TGraphic;
  p: TPicture;
  i: Integer;
begin
  if OpenPictureDialog1.Execute = true then
    for i := 0 to OpenPictureDialog1.Files.Count - 1 do
    begin
      if ExtractFileExt(OpenPictureDialog1.Files[i]) = '.png' then
        s:=TPngImage.Create
      else
      begin
        p:=TPicture.Create;
        p.LoadFromFile(OpenPictureDialog1.FileName);
        s:=p.Graphic;
      end;
      s.LoadFromFile(OpenPictureDialog1.Files[i]);
      List.Add(s);
      Label2.Caption := IntToStr(List.Count);
      Execute(UpDown1.Position);
    end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  i: Integer;
  s: TBitmap;
begin
  for i := 0 to List.Count - 1 do
    TPngImage(List[i]).Free;
  List.Clear;
  Label2.Caption := '0';
  s:=Image1.Picture.Bitmap;
  s.Canvas.FillRect(Rect(0,0,s.Width,s.Height));
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  if SavePictureDialog1.Execute = true then
    Image1.Picture.Bitmap.SaveToFile(SavePictureDialog1.FileName);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  List := TList.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  Button2Click(Sender);
  List.Free;
end;

procedure TForm1.UpDown1ChangingEx(Sender: TObject; var AllowChange: Boolean;
  NewValue: Integer; Direction: TUpDownDirection);
var
  n: integer;
begin
  case Direction of
    updUp:
      n:=UpDown1.Position+UpDown1.Increment;
    updDown:
      n:=UpDown1.Position-UpDown1.Increment;
    else
      Exit;
  end;
  Execute(n);
end;

procedure TForm1.Execute(aCount: integer);
var
  i: Integer;
  s: TGraphic;
  bmp: TBitmap;
  j: Integer;
  k, m: Integer;
label label1;
  procedure Draw;
  var
    p: TPngImage;
    t: TBitmap;
  begin
    if s is TPngImage then
      (s as TPngImage).Draw(bmp.Canvas, Rect(i * s.Width, j * s.Height, (i + 1) * s.Width,
        (j + 1) * s.Height))
    else
    begin
      t:=TBitmap.Create;
      t.Assign(s);
      bmp.Canvas.Draw(i*s.Width,j*s.Height,t);
    end;
  end;
begin
  if List.Count = 0 then
    Exit
  else
    s:=List[0];
  m := List.Count div aCount;
  bmp := TBitmap.Create;
  try
    bmp.Width := s.Width * m;
    bmp.Height := s.Height * aCount;
    k := 0;
    for j := 0 to aCount-1 do
      for i := 0 to m - 1 do
      begin
        if k <= List.Count - 1 then
        begin
          s := List[k];
          inc(k);
        end
        else
          goto label1;
        Draw;
      end;
    label1:
    Image1.Picture.Bitmap.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

end.