Разбивка изображения. FreePascal

imageswebutils.pas

unit imageswebutils;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FPimage, FPImgCanv, fgl;

type
  TImageCanvasList = specialize TFPGObjectList<TFPImageCanvas>;

procedure CropImages(SourceCanvas: TFPImageCanvas; CropRow, CropCol: Integer;
  DestImages: TImageCanvasList);
procedure CropImages(SourceCanvas: TFPImageCanvas; CropCol: Integer;
  DestImages: TImageCanvasList; out CropRow: Integer);overload;


implementation

procedure ProposeImage(const Width, Height, ColCount: Integer;
  out NewWidth, NewHeight, RowCount: Integer);
var
  a: Integer;
begin
  a:=Width div ColCount;
  RowCount:=Height div a;
  NewWidth:=a*ColCount;
  NewHeight:=a*RowCount;
end;

procedure CropImages(SourceCanvas: TFPImageCanvas; CropRow, CropCol: Integer;
  DestImages: TImageCanvasList);
var
  Img: TFPMemoryImage;
  DestCanvas: TFPImageCanvas;
  W, H, X, Y: Integer;
  Col, Row: Integer;
begin
  W:=SourceCanvas.Image.Width div CropCol;
  H:=SourceCanvas.Image.Height div CropRow;
  DestImages.Count:=CropCol*CropRow;
  Y:=0;
  for Row:=0 to CropRow-1 do
  begin
    X:=0;
    for Col:=0 to CropCol-1 do
    begin
      Img:=TFPMemoryImage.create(W,H);
      DestCanvas:=TFPImageCanvas.create(Img);
      DestCanvas.CopyRect(0,0,SourceCanvas,Rect(X, Y, X+W-1, Y+H-1));
      DestImages[Col+Row*CropCol]:=DestCanvas;
      X+=W;
    end;
    Y+=H;
  end;
end;

procedure CropImages(SourceCanvas: TFPImageCanvas; CropCol: Integer;
  DestImages: TImageCanvasList; out CropRow: Integer);
var
  Img, BImg: TFPMemoryImage;
  BCanvas, DestCanvas: TFPImageCanvas;
  W, H, X, Y: Integer;
  Col, Row: Integer;
begin
  with SourceCanvas.Image do
    ProposeImage(Width, Height, CropCol, W, H, CropRow);
  BImg:=TFPMemoryImage.create(W, H);
  BCanvas:=TFPImageCanvas.create(BImg);
  X:=(SourceCanvas.Image.Width-W) div 2;
  Y:=(SourceCanvas.Image.Height-H) div 2;
  BCanvas.CopyRect(0,0,SourceCanvas,Rect(X,Y,X+W-1,Y+H-1));
  W:=BImg.Width div CropCol;
  H:=BImg.Height div CropRow;
  DestImages.Count:=CropCol*CropRow;
  Y:=0;
  for Row:=0 to CropRow-1 do
  begin
    X:=0;
    for Col:=0 to CropCol-1 do
    begin
      Img:=TFPMemoryImage.create(W,H);
      DestCanvas:=TFPImageCanvas.create(Img);
      DestCanvas.CopyRect(0,0,BCanvas,Rect(X, Y, X+W-1, Y+H-1));
      DestImages[Col+Row*CropCol]:=DestCanvas;
      X+=W;
    end;
    Y+=H;
  end;
  BCanvas.Free;
  BImg.Free;
end;

end.