BaiduFMX

1
unit FMXGR32DemoMain;
2

3
interface
4

5
uses
6
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
7
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
8
  FMX.Controls.Presentation, FMX.StdCtrls, System.Math.Vectors,
9
  GR32_Transforms, GR32, System.Math, FMX.Layouts, TypInfo,
10
  FMX.Platform, FMX.ListBox, GR32_Resamplers;
11

12
type
13
  TFMXGR32DemoMainFrom = class(TForm)
14
    Image1: TImage;
15
    Layout2: TLayout;
16
    Image2: TImage;
17
    Rectangle3: TRectangle;
18
    Label13: TLabel;
19
    Rectangle1: TRectangle;
20
    Label1: TLabel;
21
    CmbResamplerClassNames: TComboBox;
22
    procedure FormCreate(Sender: TObject);
23
    procedure Layout2Resize(Sender: TObject);
24
    procedure CmbResamplerClassNamesChange(Sender: TObject);
25
  private const
26
    DESIRE_FORMAT: TPixelFormat =
27
    {$IFDEF ANDROID}
28
    TPixelFormat.RGBA
29
    {$ELSE}
30
    TPixelFormat.BGRA
31
    {$ENDIF}
32
    ;
33
  private
34
    { Private declarations }
35
    Transformation: TProjectiveTransformation;
36
    FScaleFactor: Single;
37
    Vertices: array [0..3] of TPointF;
38
    procedure DoPointChanged(Sender: TObject; var X, Y: Single);
39
    procedure DoTransform;
40
  public
41
    { Public declarations }
42
  end;
43

44
var
45
  FMXGR32DemoMainFrom: TFMXGR32DemoMainFrom;
46

47
implementation
48
{$R *.fmx}
49

50
procedure TFMXGR32DemoMainFrom.CmbResamplerClassNamesChange(Sender: TObject);
51
begin
52
  DoTransform;
53
end;
54

55
procedure TFMXGR32DemoMainFrom.DoPointChanged(Sender: TObject; var X, Y: Single);
56
var
57
  idx: Integer;
58
begin
59
  idx := (Sender as TComponent).Tag;
60
  Vertices[idx].X := X;
61
  Vertices[idx].Y := Y;
62
  DoTransform;
63
end;
64

65
procedure TFMXGR32DemoMainFrom.DoTransform;
66
var
67
  src, dst: TBitmap32;
68
  maxx,maxy: Single;
69
  I: Integer;
70
  s: string;
71
  dstBitmap, tmp: TBitmap;
72
begin
73
  if image1.Bitmap.PixelFormat <> DESIRE_FORMAT then
74
  begin
75
    s := TypInfo.GetEnumName(TypeInfo(TPixelFormat), Integer(image1.Bitmap.PixelFormat));
76
    ShowMessage('wrong with ' + s);
77
    Exit;
78
  end;
79

80
  maxx := 0;
81
  maxy := 0;
82
  for I := 0 to 3 do
83
  begin
84
    maxx := max(maxx, Vertices[I].X);
85
    maxy := max(maxy, Vertices[I].Y);
86
  end;
87

88
  Transformation.X0 := Vertices[0].X;
89
  Transformation.Y0 := Vertices[0].Y;
90
  Transformation.X1 := Vertices[1].X;
91
  Transformation.Y1 := Vertices[1].Y;
92
  Transformation.X2 := Vertices[2].X;
93
  Transformation.Y2 := Vertices[2].Y;
94
  Transformation.X3 := Vertices[3].X;
95
  Transformation.Y3 := Vertices[3].Y;
96
  Transformation.SrcRect := FloatRect(0,0,200,200);
97
  src := TBitmap32.Create();
98
  dst := TBitmap32.Create();
99
  dstBitmap := TBitmap.Create;
100
  try
101
    src.Assign(Image1.Bitmap);
102
    with CmbResamplerClassNames do
103
      if ItemIndex >= 0 then
104
        Src.ResamplerClassName := Items[ ItemIndex ];
105
    dst.SetSize(ceil(maxx), ceil(maxy));
106
    Dst.Clear($00000000);
107
    Transform(Dst, Src, Transformation);
108
    dstBitmap.Assign(dst);
109
    if FScaleFactor = 1 then
110
      Image2.Bitmap := dstBitmap
111
    else
112
    begin
113
      tmp := TBitmap.Create;
114
      try
115
        tmp.SetSize(Round(dstBitmap.Width * FScaleFactor), Round(dstBitmap.Height * FScaleFactor));
116
        tmp.Canvas.BeginScene;
117
        tmp.Clear(0);
118
        tmp.Canvas.DrawBitmap(dstBitmap, dstBitmap.Bounds, tmp.Bounds, 1);
119
        tmp.Canvas.EndScene;
120
        Image2.Bitmap := tmp;
121
      finally
122
        tmp.Free;
123
      end;
124
    end;
125
  finally
126
    dstBitmap.Free;
127
    dst.Free;
128
    src.Free;
129
  end;
130
end;
131

132
procedure TFMXGR32DemoMainFrom.FormCreate(Sender: TObject);
133
var
134
  I: Integer;
135
  Shape: TSelectionPoint;
136
  ScreenSrv: IFMXScreenService;
137
begin
138

139
  if TPlatformServices.Current.SupportsPlatformService(IFMXScreenService, ScreenSrv) then
140
    FScaleFactor := ScreenSrv.GetScreenScale
141
  else
142
    FScaleFactor := 1;
143

144
  Transformation := TProjectiveTransformation.Create;
145
  Vertices[0] := Point(0,0);
146
  Vertices[1] := Point(200,0);
147
  Vertices[2] := Point(200,200);
148
  Vertices[3] := Point(0,200);
149
  for I := 0 to 3 do
150
  begin
151
    Shape := TSelectionPoint.Create(Self);
152
    Shape.Parent := Image2;
153
    Shape.GripSize := 9;
154
    Shape.Position.X := Vertices[i].X;
155
    Shape.Position.Y := Vertices[i].Y;
156
    Shape.OnTrack := DoPointChanged;
157
    Shape.Tag := i;
158
  end;
159
  ResamplerList.GetClassNames(CmbResamplerClassNames.Items);
160
  CmbResamplerClassNames.ItemIndex := 0;
161
end;
162

163
procedure TFMXGR32DemoMainFrom.Layout2Resize(Sender: TObject);
164
begin
165
  Image1.Position.Point := TPoint.Zero;
166
  if Layout2.Width > Layout2.Height then
167
  begin
168
    Image1.Size.Size := TSizeF.Create(Layout2.Width / 2, Layout2.Height);
169
    Image2.Position.Point := PointF(Layout2.Width/2, 0);
170
    Image2.Size.Size := TSizeF.Create(Layout2.Width / 2, Layout2.Height);
171
  end
172
  else
173
  begin
174
    Image1.Size.Size := TSizeF.Create(Layout2.Width, Layout2.Height/2);
175
    Image2.Position.Point := PointF(0, Layout2.Height/2);
176
    Image2.Size.Size := TSizeF.Create(Layout2.Width, Layout2.Height/2);
177
  end;
178
end;
179

180
end.
181