林志玲9宫格的报名照代码生成（firemonkey）

效果：

导出的图片：

缘起：

摄影店中拍报名照，看到店员使用ps上下翻飞操作鼠标，生成9联张的报名照，又佩服有可惜：叹曰“唯手熟尔。”

那么有没有办法，可以快速生成任意组合的联排照片，并且做到快捷的生成呢？

思路：

1、使用flowlayout自动排版功能。

2、使用scalelayout自动缩放界面。

3、使用rectangle作为显示照片的container。

4、使用stylebook作为皮肤来美化界面。

代码：

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.StdCtrls,
  FMX.Layouts, FMX.Objects, FMX.ExtCtrls, FMX.Controls.Presentation, FMX.Edit,
  FMX.EditBox, FMX.SpinBox;

type
  TForm1 = class(TForm)
    FlowLayout1: TFlowLayout;
    OpenDialog1: TOpenDialog;
    SpeedButton1: TSpeedButton;
    Image1: TImage;
    CornerButton1: TCornerButton;
    sph: TSpinBox;
    spw: TSpinBox;
    Label1: TLabel;
    Label2: TLabel;
    spc: TSpinBox;
    spr: TSpinBox;
    sphg: TSpinBox;
    spvg: TSpinBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    ScaledLayout1: TScaledLayout;
    StyleBook1: TStyleBook;
    Button1: TButton;
    procedure SpeedButton1Click(Sender: TObject);
    procedure CornerButton1Click(Sender: TObject);
    procedure Image1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
var
  tmpbmp: TBitmap;
begin
  tmpbmp := Self.FlowLayout1.MakeScreenshot;
  tmpbmp.SaveToFile('d:\zjlzl.jpg');
end;

procedure TForm1.CornerButton1Click(Sender: TObject);
var
  i, j, m: integer;
//  tmprec: array[0..8] of TRectangle;
  tmprec: array of TRectangle;
  totalint: Integer;
  deleteretangle: array of TRectangle;
begin




  totalint := Trunc(spr.Value * spc.Value);

  if Self.FlowLayout1.ControlsCount > 0 then
  begin
    for m := Length(tmprec) - 1 downto 0 do  //edit1不释放，注意此处的downto，根据栈后进先出原则，否则会报错
    begin
      try
        tmprec[m].Free;

      except
      //ShowMessage('释放动态创建组件的内存失败！');
      end;
    end;
    SetLength(deleteretangle, FlowLayout1.ControlsCount);

    for i := 0 to Self.FlowLayout1.ControlsCount - 1 do
    begin
      if FlowLayout1.Controls[i] is TRectangle then
      begin
        deleteretangle[i] := TRectangle(FlowLayout1.Controls[i]);
      end;
    end;
    for i := Low(deleteretangle) to High(deleteretangle) do
    begin
      deleteretangle[i].Free;
    end;
  end;

  SetLength(tmprec, totalint);
  for i := 0 to totalint - 1 do
  begin
    tmprec[i] := TRectangle.Create(Self);
    with tmprec[i] do
    begin
      Name := 'Rectangle' + IntTostr(i);
      Parent := self.FlowLayout1;
      Width := Self.spw.Value;
      Height := Self.sph.Value;
      tmprec[i].Fill.Bitmap.Bitmap.LoadFromFile('d:\fm证件照\zj2.jpg');
      tmprec[i].Fill.Bitmap.WrapMode := TWrapMode.TileStretch;
      tmprec[i].fill.Kind := TBrushkind.Bitmap;
    end;
  end;
  Self.FlowLayout1.Height := Self.sph.Value * self.spc.Value + ((spc.Value - 1) * sphg.Value);
  Self.FlowLayout1.Width := Self.spw.Value * self.spr.Value + ((spr.Value - 1) * spvg.Value);
  FlowLayout1.HorizontalGap := Self.sphg.Value;
  FlowLayout1.VerticalGap := Self.spvg.Value;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Self.StyleBook := self.StyleBook1;
  self.StyleBook1.FileName := 'C:\Program Files (x86)\Embarcadero\Studio\15.0\Redist\styles\Fmx\GoldenGraphite.Style';
end;

procedure TForm1.Image1Click(Sender: TObject);
begin
  Self.spw.Value := Self.Image1.Bitmap.Width;
  Self.sph.Value := Self.Image1.Bitmap.Height;

end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin

  self.Image1.Bitmap.LoadFromFile('d:\fm证件照\zj2.jpg');

end;

end.

源码：

链接：https://pan.baidu.com/s/1G_jlsJ3USK4-OAm22neuPQ 
提取码：1buy