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: TPngImage;
  i: Integer;
begin
  if OpenPictureDialog1.Execute = true then
    for i := 0 to OpenPictureDialog1.Files.Count - 1 do
    begin
      s := TPngImage.Create;
      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: TPngImage;
  bmp: TBitmap;
  j: Integer;
  k, m: Integer;
label label1;
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;
        s.Draw(bmp.Canvas, Rect(i * s.Width, j * s.Height, (i + 1) * s.Width,
          (j + 1) * s.Height));
      end;
    label1:
    Image1.Picture.Bitmap.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

end.