/
glscene
/
BaiduFMX
GigaCode
beta
ОбзорЦентр заботыВойти

BaiduFMX

Форк
0
Ветки: 2Коммиты: 138Теги: 0
BaiduFMX
/Demo
/PhotoCorrect
/
PerspectiveCorrect.pas 
346 строк · 8.6 Кб
1
unit PerspectiveCorrect;
2


3
interface
4


5
uses
6
  System.Math,
7
  SimpleSVD,
8
  GR32,
9
  GR32_Transforms,
10
  GR32_Math,
11
  GR32_Blend;
12


13
type
14
  TMyProjectiveTransformation = class(T3x3Transformation)
15
  private
16
    FDestHeight: TFloat;
17
    FDestWidth: TFloat;
18
    FQuadX: array [0..3] of TFloat;
19
    FQuadY: array [0..3] of TFloat;
20
    function GetDestHeight: TFloat;
21
    function GetDestWidth: TFloat;
22
    procedure SetX0(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
23
    procedure SetX1(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
24
    procedure SetX2(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
25
    procedure SetX3(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
26
    procedure SetY0(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
27
    procedure SetY1(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
28
    procedure SetY2(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
29
    procedure SetY3(Value: TFloat); {$IFDEF UseInlining} inline; {$ENDIF}
30
  protected
31
    procedure PrepareTransform; override;
32
    procedure ReverseTransformFixed(DstX, DstY: TFixed; out SrcX, SrcY: TFixed); override;
33
    procedure ReverseTransformFloat(DstX, DstY: TFloat; out SrcX, SrcY: TFloat); override;
34
    procedure TransformFixed(SrcX, SrcY: TFixed; out DstX, DstY: TFixed); override;
35
    procedure TransformFloat(SrcX, SrcY: TFloat; out DstX, DstY: TFloat); override;
36
  public
37
    function GetTransformedBounds(const ASrcRect: TFloatRect): TFloatRect; override;
38
    property DestWidth: TFloat read GetDestWidth;
39
    property DestHeight: TFloat read GetDestHeight;
40
  published
41
    property X0: TFloat read FQuadX[0] write SetX0;
42
    property X1: TFloat read FQuadX[1] write SetX1;
43
    property X2: TFloat read FQuadX[2] write SetX2;
44
    property X3: TFloat read FQuadX[3] write SetX3;
45
    property Y0: TFloat read FQuadY[0] write SetY0;
46
    property Y1: TFloat read FQuadY[1] write SetY1;
47
    property Y2: TFloat read FQuadY[2] write SetY2;
48
    property Y3: TFloat read FQuadY[3] write SetY3;
49
  end;
50


51
function getPerspectiveTransform(const src,
52
  dst: TArray<TFloatPoint>): TFloatMatrix;
53
implementation
54


55
function getPerspectiveTransform(const src,
56
  dst: TArray<TFloatPoint>): TFloatMatrix;
57
const
58
  DECOMP_SVD      = 1;
59


60
var
61
  A, b, c: TMatrix;
62
  M, N, i: Integer;
63
  svd_deomposition: TSVD;
64
  A_pinv: TMatrix;
65
  Mat: TFloatMatrix;
66
begin
67
  M := 8;
68
  N := 8;
69
  A := TMatrix.Create(M, N, 'A', TMatrix.AS_MATRIX);
70
  b := TMatrix.Create(M, 1, 'b', TMatrix.AS_VECTOR);
71
  c := TMatrix.Create(N, 1, 'c', TMatrix.AS_VECTOR);
72


73
  for i := 0 to 3 do
74
  begin
75
      A[i,0] := src[i].X;
76
      A[i+4,3] := src[i].X;
77
      A[i,1] := src[i].Y;
78
      a[i+4,4] := src[i].Y;
79
      A[i,2] := 1;
80
      A[i+4,5] := 1;
81
      A[i,3] := 0;
82
      A[i,4] := 0;
83
      A[i,5] := 0;
84
      A[i+4,0] := 0;
85
      A[i+4,1] := 0;
86
      A[i+4,2] := 0;
87
      A[i,6] := -src[i].x*dst[i].x;
88
      A[i,7] := -src[i].y*dst[i].x;
89
      A[i+4,6] := -src[i].x*dst[i].y;
90
      A[i+4,7] := -src[i].y*dst[i].y;
91
      B.Mat[i] := dst[i].x;
92
      B.Mat[i+4] := dst[i].y;
93
  end;
94
  svd_deomposition := TSVD.Create;
95
  A_pinv := nil;
96
  try
97
    A_pinv := svd_deomposition.PinvCompute(A, A.Rows, A.Cols);
98
    svd_deomposition.multiply(A_pinv, b, c);
99
    Mat[0][0] := c.Mat[0];
100
    Mat[1][0] := c.Mat[1];
101
    Mat[2][0] := c.Mat[2];
102
    Mat[0][1] := c.Mat[3];
103
    Mat[1][1] := c.Mat[4];
104
    Mat[2][1] := c.Mat[5];
105
    Mat[0][2] := c.Mat[6];
106
    Mat[1][2] := c.Mat[7];
107
    Mat[2][2] := 1;
108
    Result := Mat;
109
  finally
110
    A_pinv.Free;
111
    svd_deomposition.Free;
112
  end;
113
end;
114


115
{ TMyProjectiveTransformation }
116


117
function TMyProjectiveTransformation.GetDestHeight: TFloat;
118
begin
119
  if not TransformValid then PrepareTransform;
120
  Result := FDestHeight;
121
end;
122


123
function TMyProjectiveTransformation.GetDestWidth: TFloat;
124
begin
125
  if not TransformValid then PrepareTransform;
126
  Result := FDestWidth;
127
end;
128


129
function TMyProjectiveTransformation.GetTransformedBounds(
130
  const ASrcRect: TFloatRect): TFloatRect;
131
var
132
  p0, p1, p2, p3: TFloatPoint;
133
begin
134
  p0 := Transform(FloatPoint(X0, Y0));
135
  p1 := Transform(FloatPoint(X1, Y1));
136
  p2 := Transform(FloatPoint(X2, Y2));
137
  p3 := Transform(FloatPoint(X3, Y3));
138


139
//  p0 := (FloatPoint(X0, Y0));
140
//  p1 := (FloatPoint(X1, Y1));
141
//  p2 := (FloatPoint(X2, Y2));
142
//  p3 := (FloatPoint(X3, Y3));
143


144
  Result.Left   := Min(Min(p0.X, p1.X), Min(p2.X, p3.X));
145
  Result.Right  := Max(Max(p0.X, p1.X), Max(p2.X, p3.X));
146
  Result.Top    := Min(Min(p0.Y, p1.Y), Min(p2.Y, p3.Y));
147
  Result.Bottom := Max(Max(p0.Y, p1.Y), Max(p2.Y, p3.Y));
148
end;
149


150
function Distance(P1, P2: TFloatPoint): Single;
151
begin
152
  Result := Sqrt(Sqr(P1.X - P2.X) + Sqr(P1.Y - P2.Y));
153
end;
154


155
procedure TMyProjectiveTransformation.PrepareTransform;
156
var
157
  widthA, widthB, heightA, heightB: TFloat;
158
  src, dst: TArray<TFloatPoint>;
159
begin
160
  src := TArray<TFloatPoint>.Create(
161
    FloatPoint(X0, Y0),
162
    FloatPoint(X1, Y1),
163
    FloatPoint(X2, Y2),
164
    FloatPoint(X3, Y3)
165
  );
166
  widthA := Distance(src[2], src[3]);
167
  widthB := Distance(src[1], src[0]);
168
  FDestWidth := Max(widthA, widthB);
169


170
  heightA := Distance(src[1], src[2]);
171
  heightB := Distance(src[0], src[3]);
172
  FDestHeight := Max(heightA, heightB);
173


174
  dst := TArray<TFloatPoint>.Create(
175
    FloatPoint(0, 0),
176
    FloatPoint(FDestWidth, 0),
177
    FloatPoint(FDestWidth, FDestHeight),
178
    FloatPoint(0, FDestHeight)
179
  );
180


181
  FMatrix := getPerspectiveTransform(src, dst);
182
//  Invert(FMatrix);
183
  inherited;
184
end;
185


186
procedure TMyProjectiveTransformation.ReverseTransformFixed(DstX, DstY: TFixed;
187
  out SrcX, SrcY: TFixed);
188
var
189
  Z: TFixed;
190
  Zf: TFloat;
191
begin
192
  Z := FixedMul(FInverseFixedMatrix[0, 2], DstX) +
193
    FixedMul(FInverseFixedMatrix[1, 2], DstY) + FInverseFixedMatrix[2, 2];
194


195
  if Z = 0 then Exit;
196


197
  {$IFDEF UseInlining}
198
  SrcX := FixedMul(DstX, FInverseFixedMatrix[0, 0]) +
199
    FixedMul(DstY, FInverseFixedMatrix[1, 0]) + FInverseFixedMatrix[2, 0];
200
  SrcY := FixedMul(DstX, FInverseFixedMatrix[0,1]) +
201
    FixedMul(DstY, FInverseFixedMatrix[1, 1]) + FInverseFixedMatrix[2, 1];
202
  {$ELSE}
203
  inherited;
204
  {$ENDIF}
205


206
  if Z <> FixedOne then
207
  begin
208
    EMMS;
209
    Zf := FixedOne / Z;
210
    SrcX := Round(SrcX * Zf);
211
    SrcY := Round(SrcY * Zf);
212
  end;
213
end;
214


215
procedure TMyProjectiveTransformation.ReverseTransformFloat(DstX, DstY: TFloat;
216
  out SrcX, SrcY: TFloat);
217
var
218
  Z: TFloat;
219
begin
220
  EMMS;
221
  Z := FInverseMatrix[0, 2] * DstX + FInverseMatrix[1, 2] * DstY +
222
    FInverseMatrix[2, 2];
223


224
  if Z = 0 then Exit;
225


226
  {$IFDEF UseInlining}
227
  SrcX := DstX * FInverseMatrix[0, 0] + DstY * FInverseMatrix[1, 0] +
228
    FInverseMatrix[2, 0];
229
  SrcY := DstX * FInverseMatrix[0, 1] + DstY * FInverseMatrix[1, 1] +
230
    FInverseMatrix[2, 1];
231
  {$ELSE}
232
  inherited;
233
  {$ENDIF}
234


235
  if Z <> 1 then
236
  begin
237
    Z := 1 / Z;
238
    SrcX := SrcX * Z;
239
    SrcY := SrcY * Z;
240
  end;
241
end;
242


243
procedure TMyProjectiveTransformation.SetX0(Value: TFloat);
244
begin
245
  FQuadX[0] := Value;
246
  Changed;
247
end;
248


249
procedure TMyProjectiveTransformation.SetX1(Value: TFloat);
250
begin
251
  FQuadX[1] := Value;
252
  Changed;
253
end;
254


255
procedure TMyProjectiveTransformation.SetX2(Value: TFloat);
256
begin
257
  FQuadX[2] := Value;
258
  Changed;
259
end;
260


261
procedure TMyProjectiveTransformation.SetX3(Value: TFloat);
262
begin
263
  FQuadX[3] := Value;
264
  Changed;
265
end;
266


267
procedure TMyProjectiveTransformation.SetY0(Value: TFloat);
268
begin
269
  FQuadY[0] := Value;
270
  Changed;
271
end;
272


273
procedure TMyProjectiveTransformation.SetY1(Value: TFloat);
274
begin
275
  FQuadY[1] := Value;
276
  Changed;
277
end;
278


279
procedure TMyProjectiveTransformation.SetY2(Value: TFloat);
280
begin
281
  FQuadY[2] := Value;
282
  Changed;
283
end;
284


285
procedure TMyProjectiveTransformation.SetY3(Value: TFloat);
286
begin
287
  FQuadY[3] := Value;
288
  Changed;
289
end;
290


291


292
procedure TMyProjectiveTransformation.TransformFixed(SrcX, SrcY: TFixed;
293
  out DstX, DstY: TFixed);
294
var
295
  Z: TFixed;
296
  Zf: TFloat;
297
begin
298
  Z := FixedMul(FFixedMatrix[0, 2], SrcX) +
299
    FixedMul(FFixedMatrix[1, 2], SrcY) + FFixedMatrix[2, 2];
300


301
  if Z = 0 then Exit;
302


303
  {$IFDEF UseInlining}
304
  DstX := FixedMul(SrcX, FFixedMatrix[0, 0]) +
305
    FixedMul(SrcY, FFixedMatrix[1, 0]) + FFixedMatrix[2, 0];
306
  DstY := FixedMul(SrcX, FFixedMatrix[0, 1]) +
307
    FixedMul(SrcY, FFixedMatrix[1, 1]) + FFixedMatrix[2, 1];
308
  {$ELSE}
309
  inherited;
310
  {$ENDIF}
311


312
  if Z <> FixedOne then
313
  begin
314
    EMMS;
315
    Zf := FixedOne / Z;
316
    DstX := Round(DstX * Zf);
317
    DstY := Round(DstY * Zf);
318
  end;
319
end;
320


321
procedure TMyProjectiveTransformation.TransformFloat(SrcX, SrcY: TFloat;
322
  out DstX, DstY: TFloat);
323
var
324
  Z: TFloat;
325
begin
326
  EMMS;
327
  Z := FMatrix[0, 2] * SrcX + FMatrix[1, 2] * SrcY + FMatrix[2, 2];
328


329
  if Z = 0 then Exit;
330


331
  {$IFDEF UseInlining}
332
  DstX := SrcX * Matrix[0, 0] + SrcY * Matrix[1, 0] + Matrix[2, 0];
333
  DstY := SrcX * Matrix[0, 1] + SrcY * Matrix[1, 1] + Matrix[2, 1];
334
  {$ELSE}
335
  inherited;
336
  {$ENDIF}
337


338
  if Z <> 1 then
339
  begin
340
    Z := 1 / Z;
341
    DstX := DstX * Z;
342
    DstY := DstY * Z;
343
  end;
344
end;
345


346
end.
347

Использование cookies

Мы используем файлы cookie в соответствии с Политикой конфиденциальности и Политикой использования cookies.

Нажимая кнопку «Принимаю», Вы даете АО «СберТех» согласие на обработку Ваших персональных данных в целях совершенствования нашего веб-сайта и Сервиса GitVerse, а также повышения удобства их использования.

Запретить использование cookies Вы можете самостоятельно в настройках Вашего браузера.