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;
    CheckBox1: TCheckBox;
    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);
    procedure CheckBox1Click(Sender: TObject);
  private
    procedure Execute(aCount: Integer);
    { Private ���� }
  public
    { Public ���� }
    List: TList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  bmp1, bmp2: TBitmap;
  r: TRect;
  i, j, k: Integer;
  procedure LoadToBitmap(FileName: TFileName; var bmp: TBitmap);
  var
    s: TPngImage;
    p: TPicture;
  begin
    if ExtractFileExt(FileName) = '.png' then
    begin
      s := TPngImage.Create;
      s.LoadFromFile(FileName);
      bmp.Width := s.Width;
      bmp.Height := s.Height;
      s.Draw(bmp.Canvas, Rect(0, 0, bmp.Width, bmp.Height));
    end
    else
    begin
      p := TPicture.Create;
      p.LoadFromFile(FileName);
      bmp.Assign(p.Graphic);
    end;
  end;

begin
  if OpenPictureDialog1.Execute = true then
    for i := 0 to OpenPictureDialog1.Files.Count - 1 do
    begin
      bmp1 := TBitmap.Create;
      bmp2 := TBitmap.Create;
      try
        LoadToBitmap(OpenPictureDialog1.Files[i], bmp2);
        if CheckBox1.Checked = true then
        begin
          if bmp2.Width < bmp2.Height then
          begin
            j := (bmp2.Height - bmp2.Width) div 2;
            k := bmp2.Width;
            r := Rect(0, j, bmp2.Width, bmp2.Height - j);
          end
          else
          begin
            j := (bmp2.Width - bmp2.Height) div 2;
            k := bmp2.Height;
            r := Rect(j, 0, bmp2.Width - j, bmp2.Height);
          end;
          bmp1.Width := k;
          bmp1.Height := k;
          bmp1.Canvas.CopyRect(Rect(0, 0, bmp1.Width, bmp1.Height),
            bmp2.Canvas, r);
        end
        else
          bmp1.Assign(bmp2);
      finally
        bmp2.Free;
      end;
      List.Add(bmp1);
      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
    TBitmap(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.CheckBox1Click(Sender: TObject);
begin
  if MessageDlg('������������������', mtCustom, [mbYes, mbNo], 0) = mrYes then
  begin
    Button2Click(Sender);
    Button1Click(Sender);
  end;
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: TBitmap;
  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;
        bmp.Canvas.Draw(i * s.Width, j * s.Height, s);
      end;
  Label1:
    Image1.Picture.Bitmap.Assign(bmp);
  finally
    bmp.Free;
  end;
end;

end.