Delphi XE2 之 FireMonkey 入门(16)

窗体上需要 TImage、TOpenDialog 和六个按钮.

unit Unit1;

interface

uses

  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,

  FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects;

type

  TForm1 = class(TForm)

    Image1: TImage;

    OpenDialog1: TOpenDialog;

    Button1: TButton;

    Button2: TButton;

    Button3: TButton;

    Button4: TButton;

    Button5: TButton;

    Button6: TButton;

    procedure FormCreate(Sender: TObject);

    procedure FormDestroy(Sender: TObject);

    procedure Button1Click(Sender: TObject);

    procedure Button2Click(Sender: TObject);

    procedure Button3Click(Sender: TObject);

    procedure Button4Click(Sender: TObject);

    procedure Button5Click(Sender: TObject);

    procedure Button6Click(Sender: TObject);

  end;

var

  Form1: TForm1;

implementation

{$R *.fmx}

uses FMX.Filter;

var

  bit: TBitmap;

procedure TForm1.FormCreate(Sender: TObject);

begin

  bit := TBitmap.Create(, );

  if not OpenDialog1.Execute then Exit;

  bit.LoadFromFile(OpenDialog1.FileName);

  Image1.Bitmap.Assign(bit);

  Image1.SetBounds(, , bit.Width, bit.Height);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

  bit.Free;

end;

{高斯模糊: 一个参数}

procedure TForm1.Button1Click(Sender: TObject);

var

  filter: TFilter;

begin

  filter := FilterByName('GaussianBlur');           //GaussianBlur 是高斯模糊滤镜的名称

  filter.Values['BlurAmount'] := 0.25;              //BlurAmount 是高斯模糊参数的名称, 默认值是 1(0.1..10)

  filter.ValuesAsBitmap['input'] := bit;            //input  是给输入图片约定的索引名称, 不区分大小写

  Image1.Bitmap := filter.ValuesAsBitmap['output']; //output 是给输出图片约定的索引名称

end;

{颜色翻转: 无参数}

procedure TForm1.Button2Click(Sender: TObject);

var

  filter: TFilter;

begin

  filter := FilterByName('Invert');       //颜色翻转

  filter.ValuesAsBitmap['input'] := bit;

  Image1.Bitmap := filter.ValuesAsBitmap['output'];

end;

{灰度: 无参数}

procedure TForm1.Button3Click(Sender: TObject);

var

  filter: TFilter;

begin

  filter := FilterByName('Monochrome');

  filter.ValuesAsBitmap['input'] := bit;

  Image1.Bitmap := filter.ValuesAsBitmap['output'];

end;

{马赛克: 一个参数}

procedure TForm1.Button4Click(Sender: TObject);

var

  filter: TFilter;

begin

  filter := FilterByName('Pixelate');

  filter.Values['BlockCount'] := ; {25 : 1..1000}

  filter.ValuesAsBitmap['input'] := bit;

  Image1.Bitmap := filter.ValuesAsBitmap['output'];

end;

{对比度: 两个参数}

procedure TForm1.Button5Click(Sender: TObject);

var

  filter: TFilter;

begin

  filter := FilterByName('Contrast');

  filter.Values['Brightness'] := -0.5; {-1..1}

  filter.Values['Contrast']   := 1.5;  {0..2}

  filter.ValuesAsBitmap['input'] := bit;

  Image1.Bitmap := filter.ValuesAsBitmap['output'];

end;

{透视: 参数是四个点}

procedure TForm1.Button6Click(Sender: TObject);

var

  filter: TFilter;

begin

  filter := FilterByName('PerspectiveTransform');

  filter.Values['TopLeft'] := VarFromPointXY(, );

  filter.Values['TopRight'] := VarFromPointXY(bit.Width, );

  filter.Values['BottomRight'] := VarFromPointXY(bit.Width * , bit.Height * );

  filter.Values['BottomLeft'] := VarFromPointXY(, bit.Height);

  filter.ValuesAsBitmap['input'] := bit;

  Image1.Bitmap := filter.ValuesAsBitmap['output'];

  Image1.SetBounds(, , bit.Width * , bit.Height * );

end;

end.

Transition 分类的滤镜需要两张图片:

uses FMX.Filter;

var

  bit1,bit2: TBitmap;

{百叶窗效果}

procedure TForm1.FormCreate(Sender: TObject);

var

  filter: TFilter;

begin

  bit1 := TBitmap.Create(, );

  bit2 := TBitmap.Create(, );

  bit1.LoadFromFile('C:\Temp\test1.jpg');

  bit2.LoadFromFile('C:\Temp\test2.jpg');

  filter := FilterByName('BlindTransition');

  filter.Values['Progress'] := ;       //变换进度: 0..100; 当以此进度做动画时, PropertyName := 'Value'

  filter.Values['NumberOfBlinds'] := ; //分叶数: 2..15

  filter.ValuesAsBitmap['input'] := bit1;

  filter.ValuesAsBitmap['target'] := bit2; //target 也是约定的索引名称

  Image1.Bitmap := filter.ValuesAsBitmap['output'];

  Image1.SetBounds(, , bit1.Width, bit1.Height);

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

  bit1.Free;

  bit2.Free;

end;

///////xsfy

filter := FilterByName与filter Free，要一一对应~~

----------------

绝对有内存泄露。您可以找一个size大一点的图测试~~
我的跟踪分析如下：
1.FilterByName会建立一个对象。 Result := TFilterClass(Filters.Objects[i]).Create;
2.filter.ValuesAsBitmap['input'] := bit;///< 这里是传入源图像指针，没事 FInput := VarToBitmap(Value);
3.Image1.Bitmap := filter.ValuesAsBitmap['output'];///<这里会生成(FOutput)TBitmap 持久化经过计算的特效Bitmap FOutput.Assign(ShaderBitmap);
4.这个FOutput 是在TFilter.Destroy事件中处理
destructor TFilter.Destroy;
begin
if FOutput <> nil then
FreeAndNil(FOutput);
inherited;
end;

------------------

XE4下好多属性不对了请更新下呀
比如不能FilterByName('Monochrome');
必须要TFilterManager.FilterByName('Monochrome');
才行了

并且
filter.Values['BlurAmount'] := 0.25;
得改为
filter.ValuesAsFloat['BlurAmount'] := 0.25;
了

----------------

巴特西

Delphi XE2 之 FireMonkey 入门(16) - 滤镜: 实例测试

最新文章

热门文章