MainUnit.pas 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778
  1. unit MainUnit;
  2. (* ***** BEGIN LICENSE BLOCK *****
  3. * Version: MPL 1.1 or LGPL 2.1 with linking exception
  4. *
  5. * The contents of this file are subject to the Mozilla Public License Version
  6. * 1.1 (the "License"); you may not use this file except in compliance with
  7. * the License. You may obtain a copy of the License at
  8. * http://www.mozilla.org/MPL/
  9. *
  10. * Software distributed under the License is distributed on an "AS IS" basis,
  11. * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  12. * for the specific language governing rights and limitations under the
  13. * License.
  14. *
  15. * Alternatively, the contents of this file may be used under the terms of the
  16. * Free Pascal modified version of the GNU Lesser General Public License
  17. * Version 2.1 (the "FPC modified LGPL License"), in which case the provisions
  18. * of this license are applicable instead of those above.
  19. * Please see the file LICENSE.txt for additional information concerning this
  20. * license.
  21. *
  22. * The Original Code is Graphics32
  23. *
  24. * The Initial Developer of the Original Code is
  25. * Alex A. Denisov
  26. *
  27. * Portions created by the Initial Developer are Copyright (C) 2000-2005
  28. * the Initial Developer. All Rights Reserved.
  29. *
  30. * Contributor(s):
  31. * Michael Hansen <[email protected]>
  32. *
  33. * ***** END LICENSE BLOCK ***** *)
  34. interface
  35. {$include GR32.inc}
  36. uses
  37. {$IFNDEF FPC} Windows, {$ELSE} LResources, LCLType, {$ENDIF}
  38. SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, Grids,
  39. ExtCtrls, StdCtrls, Buttons, GR32, GR32_Image, GR32_Transforms,
  40. GR32_Resamplers, GR32_Layers, GR32_RangeBars;
  41. type
  42. TOpType = (opNone, opTranslate, opScale, opRotate, opSkew);
  43. TOpRec = record
  44. OpType: TOpType;
  45. Dx, Dy: Extended; // shifts for opTranslate mode
  46. Sx, Sy: Extended; // scale factors for opScale mode
  47. Cx, Cy, Alpha: Extended; // rotation center and angle (deg) for opRotate mode
  48. Fx, Fy: Extended; // skew factors for opSkew mode
  49. end;
  50. TOpRecs = array[0..7] of TOpRec;
  51. const
  52. OpTypes: array [0..4] of TOpType = (opNone, opTranslate, opScale, opRotate,
  53. opSkew);
  54. type
  55. TTransformMode = (tmAffine, tmProjective, tmBilinear);
  56. { TFormTranformExample }
  57. TFormTranformExample = class(TForm)
  58. BtnClearAll: TButton;
  59. CbxRepeat: TCheckBox;
  60. CmbKernelClassNames: TComboBox;
  61. CmbResamplerClassNames: TComboBox;
  62. ComboBox: TComboBox;
  63. Dst: TImage32;
  64. EdtAlpha: TEdit;
  65. EdtCodeString: TEdit;
  66. EdtCx: TEdit;
  67. EdtCy: TEdit;
  68. EdtDx: TEdit;
  69. EdtDy: TEdit;
  70. EdtFx: TEdit;
  71. EdtFy: TEdit;
  72. EdtSx: TEdit;
  73. EdtSy: TEdit;
  74. GbrAlpha: TGaugeBar;
  75. GbrDx: TGaugeBar;
  76. GbrDy: TGaugeBar;
  77. GbrFx: TGaugeBar;
  78. GbrFy: TGaugeBar;
  79. GbrSx: TGaugeBar;
  80. GbrSy: TGaugeBar;
  81. LblAlpha: TLabel;
  82. LblCodeString: TLabel;
  83. LblCx: TLabel;
  84. LblCy: TLabel;
  85. LblDx: TLabel;
  86. LblDy: TLabel;
  87. LblFx: TLabel;
  88. LblFy: TLabel;
  89. LblInfoRotate: TLabel;
  90. LblInfoSkew: TLabel;
  91. LblInfoTranslate: TLabel;
  92. LblKernel: TLabel;
  93. LblNoOperation: TLabel;
  94. LblProjectiveNote: TLabel;
  95. LblResampler: TLabel;
  96. LblScale: TLabel;
  97. LblSx: TLabel;
  98. LblSy: TLabel;
  99. LblTransformationMatrix: TLabel;
  100. LblType: TLabel;
  101. ListBox: TListBox;
  102. Notebook: TNotebook;
  103. OpacityBar: TGaugeBar;
  104. PageControl: TPageControl;
  105. {$IFDEF FPC}
  106. PageNone: TPage;
  107. PageTranslate: TPage;
  108. PageScale: TPage;
  109. PageRotate: TPage;
  110. PageSkew: TPage;
  111. {$ENDIF}
  112. PnlOpacity: TPanel;
  113. PnlOperation: TPanel;
  114. PnlTransformationMatrix: TPanel;
  115. Shape1: TShape;
  116. Shape2: TShape;
  117. Src: TImage32;
  118. StringGrid: TStringGrid;
  119. TstAffine: TTabSheet;
  120. TstProjective: TTabSheet;
  121. procedure FormCreate(Sender: TObject);
  122. procedure FormDestroy(Sender: TObject);
  123. procedure BtnClearAllClick(Sender: TObject);
  124. procedure ComboBoxChange(Sender: TObject);
  125. procedure ListBoxClick(Sender: TObject);
  126. procedure OpacityChange(Sender: TObject);
  127. procedure PageControlChange(Sender: TObject);
  128. procedure RotationChanged(Sender: TObject);
  129. procedure RotationScrolled(Sender: TObject);
  130. procedure ScaleChanged(Sender: TObject);
  131. procedure ScaleScrolled(Sender: TObject);
  132. procedure SkewChanged(Sender: TObject);
  133. procedure SkewScrolled(Sender: TObject);
  134. procedure TranslationChanged(Sender: TObject);
  135. procedure TranslationScrolled(Sender: TObject);
  136. procedure SrcRBResizingEvent(Sender: TObject; const OldLocation: TFloatRect;
  137. var NewLocation: TFloatRect; DragState: TRBDragState; Shift: TShiftState);
  138. procedure RubberLayerMouseDown(Sender: TObject; Button: TMouseButton;
  139. Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  140. procedure RubberLayerMouseMove(Sender: TObject; Shift: TShiftState; X,
  141. Y: Integer; Layer: TCustomLayer);
  142. procedure RubberLayerMouseUp(Sender: TObject; Button: TMouseButton;
  143. Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  144. procedure AppEventsIdle(Sender: TObject; var Done: Boolean);
  145. procedure ResamplerClassNamesListClick(Sender: TObject);
  146. procedure CmbResamplerClassNamesChange(Sender: TObject);
  147. procedure CmbKernelClassNamesChange(Sender: TObject);
  148. procedure DstPaintStage(Sender: TObject; Buffer: TBitmap32;
  149. StageNum: Cardinal);
  150. procedure CbxRepeatClick(Sender: TObject);
  151. procedure SrcDblClick(Sender: TObject);
  152. protected
  153. LoadingValues: Boolean;
  154. DraggedVertex: Integer;
  155. LastMousePos: TPoint;
  156. StippleStart: Single;
  157. procedure PaintHandles(Sender: TObject; BackBuffer: TBitmap32);
  158. public
  159. SrcRubberBandLayer: TRubberBandLayer;
  160. Operation: TOpRecs;
  161. Current: ^TOpRec;
  162. AffineTransformation: TAffineTransformation;
  163. ProjectiveTransformation: TProjectiveTransformation;
  164. Transformation: TTransformation;
  165. Vertices: array [0..3] of TPoint;
  166. Mode: TTransformMode;
  167. procedure ClearTransformations;
  168. procedure DoTransform;
  169. procedure GenTransform;
  170. procedure PrepareSource;
  171. procedure ShowSettings(OperationNum: Integer);
  172. procedure InitVertices; // for projective mapping
  173. end;
  174. var
  175. FormTranformExample: TFormTranformExample;
  176. implementation
  177. {$R *.dfm}
  178. uses
  179. Types,
  180. {$IFDEF Darwin}
  181. MacOSAll,
  182. {$ENDIF}
  183. GR32.ImageFormats.JPG;
  184. const
  185. CAccessMode: array [Boolean] of TPixelAccessMode = (pamSafe, pamWrap);
  186. function GetVal(Src: string; var Dst: Extended): Boolean;
  187. var
  188. Code: Integer;
  189. begin
  190. Val(Src, Dst, Code);
  191. Result := Code = 0;
  192. end;
  193. procedure TFormTranformExample.FormCreate(Sender: TObject);
  194. begin
  195. // load example image
  196. Src.Bitmap.LoadFromResourceName(HInstance, 'Delphi', RT_RCDATA);
  197. //Setup custom paintstages ("checkerboard" and border)
  198. with Dst do
  199. begin
  200. with PaintStages[0]^ do //Set up custom paintstage to draw checkerboard
  201. begin
  202. Stage := PST_CUSTOM;
  203. Parameter := 1; // use parameter to tag the stage, we inspect this in OnPaintStage
  204. end;
  205. with PaintStages.Add^ do //Insert new paintstage on top of everything else, we use this to draw border
  206. begin
  207. Stage := PST_CUSTOM;
  208. Parameter := 2;
  209. end;
  210. end;
  211. with Src do
  212. begin
  213. with PaintStages[0]^ do
  214. begin
  215. Stage := PST_CUSTOM;
  216. Parameter := 1;
  217. end;
  218. with PaintStages.Add^ do
  219. begin
  220. Stage := PST_CUSTOM;
  221. Parameter := 2;
  222. end;
  223. end;
  224. ResamplerList.GetClassNames(CmbResamplerClassNames.Items);
  225. KernelList.GetClassNames(CmbKernelClassNames.Items);
  226. CmbResamplerClassNames.ItemIndex := 0;
  227. CmbKernelClassNames.ItemIndex := 0;
  228. SrcRubberBandLayer := TRubberBandLayer.Create(Src.Layers);
  229. SrcRubberBandLayer.OnResizing := SrcRBResizingEvent;
  230. SrcRubberBandLayer.Location := FloatRect(0, 0, Src.Bitmap.Width - 1, Src.Bitmap.Height - 1);
  231. with TCustomLayer.Create(Dst.Layers) do
  232. begin
  233. OnPaint := PaintHandles;
  234. end;
  235. DraggedVertex := -1;
  236. Dst.SetupBitmap; // set the destination bitmap size to match the image size
  237. PrepareSource;
  238. ClearTransformations;
  239. ShowSettings(0);
  240. AffineTransformation := TAffineTransformation.Create;
  241. ProjectiveTransformation := TProjectiveTransformation.Create;
  242. Transformation := AffineTransformation;
  243. DoTransform;
  244. Application.OnIdle := AppEventsIdle;
  245. end;
  246. procedure TFormTranformExample.ClearTransformations;
  247. var
  248. I: Integer;
  249. begin
  250. FillChar(Operation[0], SizeOf(TOpRecs), 0);
  251. for I := 0 to 7 do
  252. begin
  253. Operation[I].Sx := 1;
  254. Operation[I].Sy := 1;
  255. Operation[I].Cx := Src.Bitmap.Width * 0.5;
  256. Operation[I].Cy := Src.Bitmap.Height * 0.5;
  257. end;
  258. end;
  259. procedure TFormTranformExample.PrepareSource;
  260. begin
  261. // make the border pixels transparent while keeping their RGB components
  262. if not CbxRepeat.Checked then
  263. SetBorderTransparent(Src.Bitmap, Src.Bitmap.BoundsRect);
  264. end;
  265. procedure TFormTranformExample.DoTransform;
  266. var
  267. i, j: Integer;
  268. begin
  269. GenTransform;
  270. Dst.BeginUpdate;
  271. Dst.Bitmap.Clear(clNone32);
  272. Transform(Dst.Bitmap, Src.Bitmap, Transformation);
  273. Dst.EndUpdate;
  274. Dst.Invalidate;
  275. if Mode = tmAffine then
  276. begin
  277. // fill the string grid
  278. for j := 0 to 2 do
  279. for i := 0 to 2 do
  280. StringGrid.Cells[i, j] := Format('%.3g', [AffineTransformation.Matrix[i, j]]);
  281. StringGrid.Col := 3; // hide grid cursor
  282. end;
  283. end;
  284. procedure TFormTranformExample.GenTransform;
  285. var
  286. I: Integer;
  287. Rec: TOpRec;
  288. S: string;
  289. begin
  290. if Mode = tmProjective then
  291. begin
  292. ProjectiveTransformation.X0 := Vertices[0].X;
  293. ProjectiveTransformation.Y0 := Vertices[0].Y;
  294. ProjectiveTransformation.X1 := Vertices[1].X;
  295. ProjectiveTransformation.Y1 := Vertices[1].Y;
  296. ProjectiveTransformation.X2 := Vertices[2].X;
  297. ProjectiveTransformation.Y2 := Vertices[2].Y;
  298. ProjectiveTransformation.X3 := Vertices[3].X;
  299. ProjectiveTransformation.Y3 := Vertices[3].Y;
  300. end
  301. else
  302. begin
  303. // affine mode
  304. AffineTransformation.Clear;
  305. for I := 0 to 7 do
  306. begin
  307. Rec := Operation[I];
  308. case Rec.OpType of
  309. opTranslate: AffineTransformation.Translate(Rec.Dx, Rec.Dy);
  310. opScale: AffineTransformation.Scale(Rec.Sx, Rec.Sy);
  311. opRotate: AffineTransformation.Rotate(Rec.Cx, Rec.Cy, Rec.Alpha);
  312. opSkew: AffineTransformation.Skew(Rec.Fx, Rec.Fy);
  313. end;
  314. case Rec.OpType of
  315. opTranslate: s := s + Format('Translate(%.3g, %.3g); ', [Rec.Dx, Rec.Dy]);
  316. opScale: s := s + Format('Scale(%.3g, %.3g); ', [Rec.Sx, Rec.Sy]);
  317. opRotate: s := s + Format('Rotate(%.3g, %.3g, %3g); ', [Rec.Cx, Rec.Cy, Rec.Alpha]);
  318. opSkew: s := s + Format('Skew(%.3g, %.3g); ', [Rec.Fx, Rec.Fy]);
  319. end;
  320. end;
  321. if Length(s) = 0 then s := 'Clear;';
  322. EdtCodeString.Text := s;
  323. end;
  324. Transformation.SrcRect := SrcRubberBandLayer.Location;
  325. end;
  326. procedure TFormTranformExample.FormDestroy(Sender: TObject);
  327. begin
  328. AffineTransformation.Free;
  329. ProjectiveTransformation.Free;
  330. end;
  331. procedure TFormTranformExample.BtnClearAllClick(Sender: TObject);
  332. begin
  333. ClearTransformations;
  334. ShowSettings(Listbox.ItemIndex);
  335. DoTransform;
  336. end;
  337. procedure TFormTranformExample.ListBoxClick(Sender: TObject);
  338. begin
  339. ShowSettings(ListBox.ItemIndex);
  340. end;
  341. procedure TFormTranformExample.ShowSettings(OperationNum: Integer);
  342. begin
  343. LoadingValues := True;
  344. ListBox.ItemIndex := OperationNum;
  345. Current := @Operation[OperationNum];
  346. Combobox.ItemIndex := Ord(Current.OpType);
  347. NoteBook.PageIndex := Ord(Current.OpType);
  348. EdtDx.Text := Format('%.4g', [Current.Dx]);
  349. EdtDy.Text := Format('%.4g', [Current.Dy]);
  350. GbrDx.Position := Round(Current.Dx * 10);
  351. GbrDy.Position := Round(Current.Dy * 10);
  352. EdtSx.Text := Format('%.4g', [Current.Sx]);
  353. EdtSy.Text := Format('%.4g', [Current.Sy]);
  354. GbrSx.Position := Round(Current.Sx * 100);
  355. GbrSy.Position := Round(Current.Sy * 100);
  356. EdtCx.Text := Format('%.4g', [Current.Cx]);
  357. EdtCy.Text := Format('%.4g', [Current.Cy]);
  358. EdtAlpha.Text := Format('%.4g', [Current.Alpha]);
  359. GbrAlpha.Position := Round(Current.Alpha * 2);
  360. EdtFx.Text := Format('%.4g', [Current.Fx]);
  361. EdtFy.Text := Format('%.4g', [Current.Fy]);
  362. GbrFx.Position := Round(Current.Fx * 100);
  363. GbrFy.Position := Round(Current.Fy * 100);
  364. LoadingValues := False;
  365. end;
  366. procedure TFormTranformExample.ComboBoxChange(Sender: TObject);
  367. begin
  368. Current.OpType := OpTypes[ComboBox.ItemIndex];
  369. ShowSettings(ListBox.ItemIndex);
  370. DoTransform;
  371. end;
  372. procedure TFormTranformExample.TranslationChanged(Sender: TObject);
  373. var
  374. Tx, Ty: Extended;
  375. begin
  376. if LoadingValues then Exit;
  377. if GetVal(EdtDx.Text, Tx) and GetVal(EdtDy.Text, Ty) then
  378. begin
  379. Current.Dx := Tx;
  380. Current.Dy := Ty;
  381. DoTransform;
  382. LoadingValues := True;
  383. GbrDx.Position := Round(Current.Dx * 10);
  384. GbrDy.Position := Round(Current.Dy * 10);
  385. LoadingValues := False;
  386. end;
  387. end;
  388. procedure TFormTranformExample.TranslationScrolled(Sender: TObject);
  389. begin
  390. if LoadingValues then Exit;
  391. Current.Dx := GbrDx.Position * 0.1;
  392. Current.Dy := GbrDy.Position * 0.1;
  393. DoTransform;
  394. LoadingValues := True;
  395. EdtDx.Text := FloatToStr(Current.Dx);
  396. EdtDy.Text := FloatToStr(Current.Dy);
  397. LoadingValues := False;
  398. end;
  399. procedure TFormTranformExample.ScaleChanged(Sender: TObject);
  400. var
  401. Sx, Sy: Extended;
  402. begin
  403. if LoadingValues then Exit;
  404. if GetVal(EdtSx.Text, Sx) and GetVal(EdtSy.Text, Sy) then
  405. begin
  406. Current.Sx := Sx;
  407. Current.Sy := Sy;
  408. DoTransform;
  409. LoadingValues := True;
  410. GbrSx.Position := Round(Current.Sx * 100);
  411. GbrSy.Position := Round(Current.Sy * 100);
  412. LoadingValues := False;
  413. end;
  414. end;
  415. procedure TFormTranformExample.ScaleScrolled(Sender: TObject);
  416. begin
  417. if LoadingValues then Exit;
  418. Current.Sx := GbrSx.Position * 0.01;
  419. Current.Sy := GbrSy.Position * 0.01;
  420. DoTransform;
  421. LoadingValues := True;
  422. EdtSx.Text := FloatToStr(Current.Sx);
  423. EdtSy.Text := FloatToStr(Current.Sy);
  424. LoadingValues := False;
  425. end;
  426. procedure TFormTranformExample.RotationChanged(Sender: TObject);
  427. var
  428. Cx, Cy, Alpha: Extended;
  429. begin
  430. if LoadingValues then Exit;
  431. if GetVal(EdtCx.Text, Cx) and GetVal(EdtCy.Text, Cy) and
  432. GetVal(EdtAlpha.Text, Alpha) then
  433. begin
  434. Current.Cx := Cx;
  435. Current.Cy := Cy;
  436. Current.Alpha := Alpha;
  437. DoTransform;
  438. LoadingValues := True;
  439. GbrAlpha.Position := Round(Alpha * 2);
  440. LoadingValues := False;
  441. end;
  442. end;
  443. procedure TFormTranformExample.RotationScrolled(Sender: TObject);
  444. begin
  445. if LoadingValues then Exit;
  446. Current.Alpha := GbrAlpha.Position * 0.5;
  447. DoTransform;
  448. LoadingValues := True;
  449. EdtAlpha.Text := FloatToStr(Current.Alpha * 0.5);
  450. LoadingValues := False;
  451. end;
  452. procedure TFormTranformExample.SkewChanged(Sender: TObject);
  453. var
  454. Fx, Fy: Extended;
  455. begin
  456. if LoadingValues then Exit;
  457. if GetVal(EdtFx.Text, Fx) and GetVal(EdtFy.Text, Fy) then
  458. begin
  459. Current.Fx := Fx;
  460. Current.Fy := Fy;
  461. DoTransform;
  462. LoadingValues := True;
  463. GbrFx.Position := Round(Current.Fx * 10);
  464. GbrFy.Position := Round(Current.Fy * 10);
  465. LoadingValues := False;
  466. end;
  467. end;
  468. procedure TFormTranformExample.SkewScrolled(Sender: TObject);
  469. begin
  470. if LoadingValues then Exit;
  471. Current.Fx := GbrFx.Position * 0.1;
  472. Current.Fy := GbrFy.Position * 0.1;
  473. DoTransform;
  474. LoadingValues := True;
  475. EdtFx.Text := FloatToStr(Current.Fx);
  476. EdtFy.Text := FloatToStr(Current.Fy);
  477. LoadingValues := False;
  478. end;
  479. procedure TFormTranformExample.OpacityChange(Sender: TObject);
  480. begin
  481. OpacityBar.Update;
  482. Src.Bitmap.MasterAlpha := OpacityBar.Position;
  483. DoTransform;
  484. end;
  485. procedure TFormTranformExample.InitVertices;
  486. begin
  487. Vertices[0].X := 0;
  488. Vertices[0].Y := 0;
  489. Vertices[1].X := Src.Bitmap.Width - 1;
  490. Vertices[1].Y := 0;
  491. Vertices[2].X := Src.Bitmap.Width - 1;
  492. Vertices[2].Y := Src.Bitmap.Height - 1;
  493. Vertices[3].X := 0;
  494. Vertices[3].Y := Src.Bitmap.Height - 1;
  495. end;
  496. procedure TFormTranformExample.PageControlChange(Sender: TObject);
  497. begin
  498. if Src = nil then
  499. Exit;
  500. if PageControl.ActivePage = TstAffine then
  501. begin
  502. Mode := tmAffine;
  503. Transformation := AffineTransformation;
  504. CmbResamplerClassNames.Parent := TstAffine;
  505. LblResampler.Parent := TstAffine;
  506. CmbKernelClassNames.Parent := TstAffine;
  507. LblKernel.Parent := TstAffine;
  508. end
  509. else
  510. begin
  511. // set current transformation as projective
  512. Mode := tmProjective;
  513. Transformation := ProjectiveTransformation;
  514. InitVertices;
  515. CmbResamplerClassNames.Parent := TstProjective;
  516. LblResampler.Parent := TstProjective;
  517. CmbKernelClassNames.Parent := TstProjective;
  518. LblKernel.Parent := TstProjective;
  519. end;
  520. DoTransform;
  521. end;
  522. procedure TFormTranformExample.RubberLayerMouseDown(Sender: TObject;
  523. Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  524. var
  525. I: Integer;
  526. begin
  527. if Mode = tmAffine then Exit;
  528. DraggedVertex := -1;
  529. // find the vertex to drag
  530. for I := 0 to 3 do
  531. if (Abs(Vertices[I].X - X) < 3) and (Abs(Vertices[I].Y - Y) < 3) then
  532. begin
  533. DraggedVertex := I;
  534. Break;
  535. end;
  536. // or drag all of them, (DragVertex = 4)
  537. if DraggedVertex = -1 then DraggedVertex := 4;
  538. // store current mouse position
  539. LastMousePos := Classes.Point(X, Y);
  540. end;
  541. procedure TFormTranformExample.RubberLayerMouseMove(Sender: TObject; Shift: TShiftState;
  542. X, Y: Integer; Layer: TCustomLayer);
  543. var
  544. Dx, Dy, I: Integer;
  545. begin
  546. if Mode = tmAffine then Exit;
  547. if DraggedVertex = -1 then Exit; // mouse is not pressed
  548. Dx := X - LastMousePos.X;
  549. Dy := Y - LastMousePos.Y;
  550. LastMousePos := Classes.Point(X, Y);
  551. // update coords
  552. if DraggedVertex = 4 then
  553. begin
  554. for I := 0 to 3 do
  555. begin
  556. Inc(Vertices[I].X, Dx);
  557. Inc(Vertices[I].Y, Dy);
  558. end;
  559. end
  560. else
  561. begin
  562. Inc(Vertices[DraggedVertex].X, Dx);
  563. Inc(Vertices[DraggedVertex].Y, Dy);
  564. end;
  565. DoTransform;
  566. end;
  567. procedure TFormTranformExample.RubberLayerMouseUp(Sender: TObject; Button: TMouseButton;
  568. Shift: TShiftState; X, Y: Integer; Layer: TCustomLayer);
  569. begin
  570. DraggedVertex := -1;
  571. end;
  572. procedure TFormTranformExample.AppEventsIdle(Sender: TObject; var Done: Boolean);
  573. begin
  574. if DraggedVertex >= 0 then Exit;
  575. StippleStart := StippleStart - 0.05;
  576. Dst.Invalidate;
  577. end;
  578. procedure TFormTranformExample.PaintHandles(Sender: TObject; BackBuffer: TBitmap32);
  579. var
  580. I, X0, Y0, X1, Y1: Integer;
  581. procedure PaintVertex(X, Y: Integer);
  582. begin
  583. BackBuffer.FillRectS(X - 2, Y - 2, X + 2, Y + 2, clWhite32);
  584. BackBuffer.FrameRectS(X - 3, Y - 3, X + 3, Y + 3, clBlack32);
  585. end;
  586. begin
  587. if PageControl.ActivePage = TstAffine then Exit;
  588. BackBuffer.SetStipple([clBlack32, clBlack32, clWhite32, clWhite32]);
  589. BackBuffer.StippleStep := 0.5;
  590. BackBuffer.StippleCounter := StippleStart;
  591. X0 := Vertices[3].X;
  592. Y0 := Vertices[3].Y;
  593. for I := 0 to 3 do
  594. begin
  595. X1 := Vertices[I].X;
  596. Y1 := Vertices[I].Y;
  597. BackBuffer.LineFSP(X0, Y0, X1, Y1);
  598. X0 := X1;
  599. Y0 := Y1;
  600. end;
  601. for I := 0 to 3 do PaintVertex(Vertices[I].X, Vertices[I].Y);
  602. end;
  603. procedure TFormTranformExample.ResamplerClassNamesListClick(Sender: TObject);
  604. begin
  605. with CmbResamplerClassNames do
  606. if ItemIndex >= 0 then
  607. Src.Bitmap.ResamplerClassName:= Items[ ItemIndex ];
  608. DoTransform;
  609. end;
  610. procedure TFormTranformExample.SrcDblClick(Sender: TObject);
  611. begin
  612. SrcRubberBandLayer.Location := FloatRect(0, 0, Src.Bitmap.Width - 1,
  613. Src.Bitmap.Height - 1);
  614. end;
  615. procedure TFormTranformExample.SrcRBResizingEvent(Sender: TObject;
  616. const OldLocation: TFloatRect; var NewLocation: TFloatRect;
  617. DragState: TRBDragState; Shift: TShiftState);
  618. begin
  619. Src.Invalidate;
  620. DoTransform;
  621. end;
  622. procedure TFormTranformExample.CmbResamplerClassNamesChange(Sender: TObject);
  623. var
  624. R: TCustomResampler;
  625. begin
  626. with CmbResamplerClassNames do
  627. if ItemIndex >= 0 then
  628. begin
  629. Src.Bitmap.BeginUpdate;
  630. R := ResamplerList[ItemIndex].Create(Src.Bitmap);
  631. if CbxRepeat.Checked then
  632. begin
  633. Src.Bitmap.WrapMode := wmRepeat;
  634. Src.Bitmap.Resampler.PixelAccessMode := CAccessMode[CbxRepeat.Checked];
  635. end;
  636. CmbKernelClassNamesChange(nil);
  637. Src.Bitmap.EndUpdate;
  638. Src.Bitmap.Changed;
  639. CmbKernelClassNames.Visible := R is TKernelResampler;
  640. LblKernel.Visible := CmbKernelClassNames.Visible;
  641. end;
  642. end;
  643. procedure TFormTranformExample.CmbKernelClassNamesChange(Sender: TObject);
  644. var
  645. Index: Integer;
  646. begin
  647. Index := CmbKernelClassNames.ItemIndex;
  648. if Src.Bitmap.Resampler is TKernelResampler then
  649. begin
  650. TKernelResampler(Src.Bitmap.Resampler).Kernel := KernelList[Index].Create;
  651. end;
  652. DoTransform;
  653. end;
  654. procedure TFormTranformExample.DstPaintStage(Sender: TObject; Buffer: TBitmap32;
  655. StageNum: Cardinal);
  656. const //0..1
  657. Colors: array [Boolean] of TColor32 = ($FFFFFFFF, $FFB0B0B0);
  658. var
  659. R: TRect;
  660. I, J: Integer;
  661. OddY: Integer;
  662. TilesHorz, TilesVert: Integer;
  663. TileX, TileY: Integer;
  664. TileHeight, TileWidth: Integer;
  665. begin
  666. if Sender is TImage32 then with TImage32(Sender) do
  667. begin
  668. BeginUpdate;
  669. R := GetViewportRect;
  670. case PaintStages[StageNum].Parameter of
  671. 1: begin //Draw Checkerboard
  672. TileHeight := 8;
  673. TileWidth := 8;
  674. TilesHorz := (R.Right - R.Left) div TileWidth;
  675. TilesVert := (R.Bottom - R.Top) div TileHeight;
  676. TileY := 0;
  677. for J := 0 to TilesVert do
  678. begin
  679. TileX := 0;
  680. OddY := J and $1;
  681. for I := 0 to TilesHorz do
  682. begin
  683. Buffer.FillRectS(TileX, TileY, TileX + TileWidth, TileY + TileHeight,Colors[I and $1 = OddY]);
  684. Inc(TileX, TileWidth);
  685. end;
  686. Inc(TileY, TileHeight);
  687. end
  688. end;
  689. 2: Buffer.FrameRectS(R , $FF000000); //Draw Frame
  690. end;
  691. EndUpdate;
  692. end;
  693. end;
  694. procedure TFormTranformExample.CbxRepeatClick(Sender: TObject);
  695. begin
  696. Src.Bitmap.WrapMode := wmRepeat;
  697. Src.Bitmap.Resampler.PixelAccessMode := CAccessMode[CbxRepeat.Checked];
  698. DoTransform;
  699. end;
  700. end.