MainUnit.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734
  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 Nested Sampling Example
  23. *
  24. * The Initial Developer of the Original Code is
  25. * Mattias Andersson <[email protected]>
  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. * Andre Beckedorf <[email protected]>
  33. *
  34. * ***** END LICENSE BLOCK ***** *)
  35. interface
  36. {$include GR32.inc}
  37. uses
  38. {$IFNDEF FPC} Windows, {$ELSE} LResources, {$ENDIF}
  39. SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls,
  40. TypInfo, SimplePropEdit, ComCtrls, Menus, ToolWin, ImgList, Buttons, ExtDlgs,
  41. GR32, GR32_Blend, GR32_Image, GR32_Math, GR32_Rasterizers, GR32_Resamplers,
  42. GR32_Transforms, GR32_Containers, GR32_ExtImage, System.ImageList;
  43. type
  44. TMainForm = class(TForm)
  45. btnRasterize: TSpeedButton;
  46. chkClear: TMenuItem;
  47. chkReset: TMenuItem;
  48. DisabledImages: TImageList;
  49. EnabledImages: TImageList;
  50. HotImages: TImageList;
  51. ImgView: TImgView32;
  52. LeftPanel: TPanel;
  53. lvSamplers: TListView;
  54. MainMenu: TMainMenu;
  55. miAdaptiveSuperSampler: TMenuItem;
  56. miAntialiasing: TMenuItem;
  57. miBloat: TMenuItem;
  58. miContour: TMenuItem;
  59. miContracter: TMenuItem;
  60. miConvolver: TMenuItem;
  61. miDilater: TMenuItem;
  62. miDisturbance: TMenuItem;
  63. miDraft: TMenuItem;
  64. miEdit: TMenuItem;
  65. miEroder: TMenuItem;
  66. miExit: TMenuItem;
  67. miExpander: TMenuItem;
  68. miFile: TMenuItem;
  69. miFisheye: TMenuItem;
  70. miJitteredPattern: TMenuItem;
  71. miKernel: TMenuItem;
  72. miLanczos: TMenuItem;
  73. miLinear: TMenuItem;
  74. miNearest: TMenuItem;
  75. miOpen: TMenuItem;
  76. miOptions: TMenuItem;
  77. miProgressive: TMenuItem;
  78. miProjective: TMenuItem;
  79. miRasterizer: TMenuItem;
  80. miRegular: TMenuItem;
  81. miResampler: TMenuItem;
  82. miRGBNoise: TMenuItem;
  83. miRotation: TMenuItem;
  84. miSaveImage: TMenuItem;
  85. miScale: TMenuItem;
  86. miSelectiveConvolver: TMenuItem;
  87. miSinsh: TMenuItem;
  88. miSkew: TMenuItem;
  89. miSpline: TMenuItem;
  90. miSupersampler: TMenuItem;
  91. miSwizzling: TMenuItem;
  92. miTesseral: TMenuItem;
  93. miTransformer: TMenuItem;
  94. miTranslation: TMenuItem;
  95. miTwirl: TMenuItem;
  96. N1: TMenuItem;
  97. N2: TMenuItem;
  98. N4: TMenuItem;
  99. N5: TMenuItem;
  100. N6: TMenuItem;
  101. N7: TMenuItem;
  102. NewItemMenu: TPopupMenu;
  103. OpenPictureDialog: TOpenPictureDialog;
  104. Panel1: TPanel;
  105. SavePictureDialog: TSavePictureDialog;
  106. Splitter1: TSplitter;
  107. stObjectInspector: TStaticText;
  108. stRasterizer: TStaticText;
  109. stSamplerManager: TStaticText;
  110. tbCopy: TToolButton;
  111. tbCut: TToolButton;
  112. tbDelete: TToolButton;
  113. tbDown: TToolButton;
  114. tbManager: TToolBar;
  115. tbNew: TToolButton;
  116. tbPaste: TToolButton;
  117. tbSplitter1: TToolButton;
  118. tbSplitter2: TToolButton;
  119. tbUp: TToolButton;
  120. procedure FormCreate(Sender: TObject);
  121. procedure FormDestroy(Sender: TObject);
  122. procedure AntialiasClick(Sender: TObject);
  123. procedure btnRasterizeClick(Sender: TObject);
  124. procedure Button2Click(Sender: TObject);
  125. procedure Button3Click(Sender: TObject);
  126. procedure Copy2Click(Sender: TObject);
  127. procedure Cut1Click(Sender: TObject);
  128. procedure KernelClick(Sender: TObject);
  129. procedure lvSamplersSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
  130. procedure miContourClick(Sender: TObject);
  131. procedure miEdit2Click(Sender: TObject);
  132. procedure miEditClick(Sender: TObject);
  133. procedure miExitClick(Sender: TObject);
  134. procedure miLinearClick(Sender: TObject);
  135. procedure miNearestClick(Sender: TObject);
  136. procedure miOpenClick(Sender: TObject);
  137. procedure miProgressiveClick(Sender: TObject);
  138. procedure miRegularClick(Sender: TObject);
  139. procedure miRGBNoiseClick(Sender: TObject);
  140. procedure miSaveImageClick(Sender: TObject);
  141. procedure miSwizzlingClick(Sender: TObject);
  142. procedure miTesseralClick(Sender: TObject);
  143. procedure Paste1Click(Sender: TObject);
  144. procedure SelectKernel(Sender: TObject);
  145. procedure tbDeleteClick(Sender: TObject);
  146. procedure tbUpDownClick(Sender: TObject);
  147. procedure TransformationClick(Sender: TObject);
  148. private
  149. procedure SetSourceResampler(const Value: TCustomResampler);
  150. function GetSourceResampler: TCustomResampler;
  151. procedure UpdateTransformations;
  152. function NewInstanceName(Sampler: TNestedSampler): string;
  153. public
  154. Source: TBitmap32;
  155. Source2: TBitmap32;
  156. Rasterizer: TRasterizer;
  157. Samplers: TList;
  158. PropertyEditor: TSimplePropertyEditor;
  159. RenderThread: TRenderThread;
  160. ClearBitmap: Boolean;
  161. IsRasterizing: Boolean;
  162. ClipBoardItem: TNestedSampler;
  163. ObjectName: string;
  164. property SourceResampler: TCustomResampler read GetSourceResampler write SetSourceResampler;
  165. procedure ThreadTerminated(Sender: TObject);
  166. procedure SetResampler(ResamplerClass: TCustomResamplerClass);
  167. procedure StopThread;
  168. function LastSampler: TCustomSampler;
  169. function SelectedSampler: TNestedSampler;
  170. function SelectedIndex: Integer;
  171. function ValidSelection: Boolean;
  172. procedure AddSampler(Sampler: TNestedSampler);
  173. procedure InsertSampler(Index: Integer; ObjName: string; Sampler: TNestedSampler);
  174. procedure DeleteSampler(Index: Integer; FreeItem: Boolean = True);
  175. end;
  176. { Simple implementation of a nested sampler }
  177. TNoiseSampler = class(TNestedSampler)
  178. public
  179. FRed, FGreen, FBlue: Integer;
  180. FRedNoise, FGreenNoise, FBlueNoise: Integer;
  181. function GetSampleFixed(X, Y: TFixed): TColor32; override;
  182. published
  183. property Red: Integer read FRed write FRed;
  184. property Green: Integer read FGreen write FGreen;
  185. property Blue: Integer read FBlue write FBlue;
  186. property RedNoise: Integer read FRedNoise write FRedNoise;
  187. property GreenNoise: Integer read FGreenNoise write FGreenNoise;
  188. property BlueNoise: Integer read FBlueNoise write FBlueNoise;
  189. end;
  190. var
  191. MainForm: TMainForm;
  192. implementation
  193. {$R *.dfm}
  194. uses
  195. Types, Math,
  196. {$IFDEF DARWIN}
  197. MacOSAll,
  198. {$ENDIF}
  199. GR32.ImageFormats.JPG,
  200. GR32_OrdinalMaps,
  201. GR32_LowLevel;
  202. procedure SetupToolBar(ToolBar: TToolBar);
  203. var
  204. I: Integer;
  205. begin
  206. with ToolBar do
  207. begin
  208. ShowCaptions := False;
  209. for I := 0 to ButtonCount - 1 do
  210. with Buttons[I] do
  211. begin
  212. if MenuItem.Count > 0 then
  213. Style := tbsDropDown
  214. else if Caption = '|' then
  215. Style := tbsSeparator
  216. else
  217. Style := tbsButton;
  218. AutoSize := False;
  219. Width := 0;
  220. Height := 0;
  221. end;
  222. end;
  223. end;
  224. { TMainForm }
  225. procedure TMainForm.FormCreate(Sender: TObject);
  226. begin
  227. // load example image
  228. Source := TBitmap32.Create;
  229. Source.LoadFromResourceName(HInstance, 'STONEWEED', RT_RCDATA);
  230. ImgView.Bitmap.SetSizeFrom(Source);
  231. Rasterizer := TRegularRasterizer.Create;
  232. TRegularRasterizer(Rasterizer).UpdateRowCount := 16;
  233. Rasterizer.Sampler := Source.Resampler;
  234. Samplers := TList.Create;
  235. PropertyEditor := TSimplePropertyEditor.Create(Self);
  236. PropertyEditor.Parent := LeftPanel;
  237. PropertyEditor.Align := alClient;
  238. with PropertyEditor do
  239. begin
  240. RegisterClassPropertyRange(TNoiseSampler, 'Red', -255, 255);
  241. RegisterClassPropertyRange(TNoiseSampler, 'Green', -255, 255);
  242. RegisterClassPropertyRange(TNoiseSampler, 'Blue', -255, 255);
  243. RegisterClassPropertyRange(TNoiseSampler, 'RedNoise', 0, 255);
  244. RegisterClassPropertyRange(TNoiseSampler, 'GreenNoise', 0, 255);
  245. RegisterClassPropertyRange(TNoiseSampler, 'BlueNoise', 0, 255);
  246. RegisterClassPropertyRange(TSuperSampler, 'SamplingX', 1, 8);
  247. RegisterClassPropertyRange(TSuperSampler, 'SamplingY', 1, 8);
  248. RegisterClassPropertyRange(TAdaptiveSuperSampler, 'Level', 0, 8);
  249. RegisterClassPropertyRange(TAdaptiveSuperSampler, 'Tolerance', 0, 255);
  250. RegisterClassPropertyRange(TKernelSampler, 'CenterX', 0, 4);
  251. RegisterClassPropertyRange(TKernelSampler, 'CenterY', 0, 4);
  252. RegisterClassPropertyRange(TSelectiveConvolver, 'Delta', 0, 255);
  253. RegisterClassPropertyRange(TTwirlTransformation, 'Twirl', 0, 0.1);
  254. RegisterClassPropertyRange(TBloatTransformation, 'BloatPower', 0, 1);
  255. RegisterClassPropertyRange(TWindowedSincKernel, 'Width', 0, 5);
  256. RegisterClassPropertyRange(TSinshKernel, 'Width', 0, 5);
  257. RegisterClassPropertyRange(TSinshKernel, 'Coeff', 0, 1);
  258. RegisterClassPropertyRange(TCubicKernel, 'Coeff', -1.5, 1.5);
  259. end;
  260. btnRasterizeClick(nil);
  261. end;
  262. procedure TMainForm.FormDestroy(Sender: TObject);
  263. var
  264. I: Integer; C: TCustomSampler;
  265. begin
  266. for I := 0 to Samplers.Count - 1 do begin
  267. C := Samplers[I];
  268. if C is TTransformer then
  269. (C as TTransformer).Transformation.Free;
  270. C.Free;
  271. end;
  272. Samplers.Clear;
  273. Samplers.Free;
  274. FreeAndNil(RenderThread);
  275. FreeAndNil(Rasterizer);
  276. FreeAndNil(Source);
  277. end;
  278. procedure TMainForm.lvSamplersSelectItem(Sender: TObject; Item: TListItem;
  279. Selected: Boolean);
  280. begin
  281. if Selected and (Item.Index >= 0) and (Item.Index < Samplers.Count) then
  282. PropertyEditor.SelectObject(Item.Caption, Samplers[Item.Index]);
  283. end;
  284. procedure TMainForm.SetResampler(ResamplerClass: TCustomResamplerClass);
  285. begin
  286. end;
  287. procedure TMainForm.btnRasterizeClick(Sender: TObject);
  288. begin
  289. if IsRasterizing then
  290. begin
  291. StopThread;
  292. end
  293. else
  294. begin
  295. miFile.Enabled := False;
  296. miResampler.Enabled := False;
  297. miRasterizer.Enabled := False;
  298. tbManager.Enabled := False;
  299. btnRasterize.Caption := 'Stop Rasterization';
  300. with ImgView do
  301. begin
  302. StopThread;
  303. if Assigned(RenderThread) then RenderThread.Free;
  304. if chkReset.Checked then
  305. SourceResampler := Source.Resampler
  306. else
  307. begin
  308. Source2 := TBitmap32.Create;
  309. Source2.Assign(Bitmap);
  310. SourceResampler := Source2.Resampler;
  311. end;
  312. if chkClear.Checked then Bitmap.Clear;
  313. RenderThread := TRenderThread.Create(Rasterizer, Bitmap, Bitmap.BoundsRect, False);
  314. RenderThread.OnTerminate := ThreadTerminated;
  315. end;
  316. IsRasterizing := True;
  317. end;
  318. end;
  319. procedure TMainForm.Button2Click(Sender: TObject);
  320. begin
  321. PropertyEditor.SelectObject('Resampler', Source.Resampler);
  322. end;
  323. procedure TMainForm.Button3Click(Sender: TObject);
  324. begin
  325. PropertyEditor.SelectObject('Rasterizer', Rasterizer);
  326. end;
  327. procedure TMainForm.tbDeleteClick(Sender: TObject);
  328. begin
  329. if ValidSelection then
  330. DeleteSampler(SelectedIndex);
  331. end;
  332. procedure TMainForm.miOpenClick(Sender: TObject);
  333. begin
  334. if OpenPictureDialog.Execute then
  335. begin
  336. Source.LoadFromFile(OpenPictureDialog.FileName);
  337. UpdateTransformations;
  338. ImgView.Bitmap.SetSizeFrom(Source);
  339. btnRasterizeClick(nil);
  340. end;
  341. end;
  342. procedure TMainForm.miSaveImageClick(Sender: TObject);
  343. begin
  344. if SavePictureDialog.Execute then
  345. Source.SaveToFile(OpenPictureDialog.FileName);
  346. end;
  347. procedure TMainForm.miExitClick(Sender: TObject);
  348. begin
  349. Close;
  350. end;
  351. procedure TMainForm.miNearestClick(Sender: TObject);
  352. begin
  353. SourceResampler := TNearestResampler.Create(Source);
  354. end;
  355. procedure TMainForm.miLinearClick(Sender: TObject);
  356. begin
  357. SourceResampler := TLinearResampler.Create(Source);
  358. end;
  359. procedure TMainForm.SelectKernel(Sender: TObject);
  360. var
  361. R: TKernelResampler;
  362. const
  363. KERNELS: array[0..3] of TCustomKernelClass =
  364. (TCubicKernel, TSplineKernel, TLanczosKernel, TSinshKernel);
  365. begin
  366. R := TKernelResampler.Create(Source);
  367. R.Kernel := KERNELS[TComponent(Sender).Tag].Create;
  368. R.KernelMode := kmTableLinear;
  369. SourceResampler := R;
  370. end;
  371. procedure TMainForm.StopThread;
  372. begin
  373. if Assigned(RenderThread) then
  374. begin
  375. RenderThread.Terminate;
  376. RenderThread.WaitFor;
  377. end;
  378. end;
  379. function TMainForm.LastSampler: TCustomSampler;
  380. begin
  381. if Samplers.Count > 0 then
  382. Result := TCustomSampler(Samplers.Last)
  383. else
  384. Result := Source.Resampler;
  385. end;
  386. procedure TMainForm.miProgressiveClick(Sender: TObject);
  387. begin
  388. Rasterizer.Free;
  389. Rasterizer := TProgressiveRasterizer.Create;
  390. Rasterizer.Sampler := LastSampler;
  391. end;
  392. procedure TMainForm.miRegularClick(Sender: TObject);
  393. begin
  394. Rasterizer.Free;
  395. Rasterizer := TRegularRasterizer.Create;
  396. TRegularRasterizer(Rasterizer).UpdateRowCount := 16;
  397. Rasterizer.Sampler := LastSampler;
  398. end;
  399. procedure TMainForm.miSwizzlingClick(Sender: TObject);
  400. begin
  401. Rasterizer.Free;
  402. Rasterizer := TSwizzlingRasterizer.Create;
  403. Rasterizer.Sampler := LastSampler;
  404. end;
  405. procedure TMainForm.miTesseralClick(Sender: TObject);
  406. begin
  407. Rasterizer.Free;
  408. Rasterizer := TTesseralRasterizer.Create;
  409. Rasterizer.Sampler := LastSampler;
  410. end;
  411. procedure TMainForm.miEditClick(Sender: TObject);
  412. begin
  413. PropertyEditor.SelectObject('Resampler', Source.Resampler);
  414. end;
  415. procedure TMainForm.miEdit2Click(Sender: TObject);
  416. begin
  417. PropertyEditor.SelectObject('Rasterizer', Rasterizer);
  418. end;
  419. procedure TMainForm.ThreadTerminated(Sender: TObject);
  420. begin
  421. if Assigned(Source2) then FreeAndNil(Source2);
  422. tbManager.Enabled := True;
  423. miFile.Enabled := True;
  424. miResampler.Enabled := True;
  425. miRasterizer.Enabled := True;
  426. btnRasterize.Caption := 'Rasterize Image';
  427. IsRasterizing := False;
  428. end;
  429. procedure TMainForm.KernelClick(Sender: TObject);
  430. type
  431. TKernelSamplerClass = class of TKernelSampler;
  432. const
  433. Classes: array[0..5] of TKernelSamplerClass =
  434. (TConvolver, TDilater, TEroder, TExpander, TContracter, TSelectiveConvolver);
  435. var
  436. Index, I, J: Integer;
  437. S: TKernelSampler;
  438. begin
  439. Index := TComponent(Sender).Tag;
  440. S := Classes[Index].Create(LastSampler);
  441. S.CenterX := 2;
  442. S.CenterY := 2;
  443. S.Kernel.SetSize(5, 5);
  444. // initialize default kernels
  445. case Index of
  446. 0: // convolver
  447. begin
  448. S.Kernel[2, 2] := 5 * 256;
  449. S.Kernel[2, 1] := -256;
  450. S.Kernel[2, 3] := -256;
  451. S.Kernel[1, 2] := -256;
  452. S.Kernel[3, 2] := -256;
  453. end;
  454. 1, 2: // dilater, eroder
  455. for I := 0 to 4 do
  456. for J := 0 to 4 do
  457. S.Kernel[I, J] := Round(-128 + 128 * Sqrt(1/6*Max(6 - Sqr(I - 2) - Sqr(J - 2), 0)));
  458. 3, 4, 5: // expander, contracter
  459. for I := 0 to 4 do
  460. for J := 0 to 4 do
  461. S.Kernel[I, J] := Round(256 * Sqrt(1/6*Max(6 - Sqr(I - 2) - Sqr(J - 2), 0)));
  462. end;
  463. AddSampler(S);
  464. end;
  465. procedure TMainForm.TransformationClick(Sender: TObject);
  466. type
  467. TTransformationClass = class of TTransformation;
  468. const
  469. Classes: array[0..8] of TTransformationClass =
  470. (nil, nil, nil, nil, TProjectiveTransformation, TTwirlTransformation,
  471. TBloatTransformation, TDisturbanceTransformation, TFishEyeTransformation);
  472. var
  473. S: TTransformer;
  474. T: TTransformation;
  475. begin
  476. if Classes[TComponent(Sender).Tag] = nil then Exit;
  477. T := Classes[TComponent(Sender).Tag].Create;
  478. T.SrcRect := FloatRect(Source.BoundsRect);
  479. S := TTransformer.Create(LastSampler, T);
  480. AddSampler(S);
  481. end;
  482. procedure TMainForm.AntialiasClick(Sender: TObject);
  483. type
  484. TNestedSamplerClass = class of TNestedSampler;
  485. const
  486. Classes: array[0..2] of TNestedSamplerClass =
  487. (TSuperSampler, TAdaptiveSuperSampler, TPatternSampler);
  488. begin
  489. AddSampler(Classes[TComponent(Sender).Tag].Create(LastSampler));
  490. end;
  491. procedure TMainForm.miContourClick(Sender: TObject);
  492. begin
  493. Rasterizer.Free;
  494. Rasterizer := TContourRasterizer.Create;
  495. Rasterizer.Sampler := LastSampler;
  496. end;
  497. procedure TMainForm.SetSourceResampler(const Value: TCustomResampler);
  498. begin
  499. if Samplers.Count > 0 then
  500. TNestedSampler(Samplers[0]).Sampler := Value
  501. else
  502. Rasterizer.Sampler := Value;
  503. end;
  504. function TMainForm.GetSourceResampler: TCustomResampler;
  505. begin
  506. Result := Source.Resampler;
  507. end;
  508. function TMainForm.SelectedSampler: TNestedSampler;
  509. begin
  510. Result := nil;
  511. if Assigned(lvSamplers.Selected) then
  512. Result := TNestedSampler(lvSamplers.Selected.Data);
  513. end;
  514. function TMainForm.SelectedIndex: Integer;
  515. begin
  516. Result := -1;
  517. if Assigned(lvSamplers.Selected) then
  518. Result := lvSamplers.Selected.Index;
  519. end;
  520. function TMainForm.ValidSelection: Boolean;
  521. begin
  522. Result := Assigned(lvSamplers.Selected);
  523. end;
  524. procedure TMainForm.Copy2Click(Sender: TObject);
  525. begin
  526. if ValidSelection then
  527. begin
  528. ClipBoardItem := SelectedSampler;
  529. ObjectName := lvSamplers.Selected.Caption;
  530. end;
  531. end;
  532. procedure TMainForm.Cut1Click(Sender: TObject);
  533. begin
  534. if ValidSelection then
  535. begin
  536. ClipBoardItem := SelectedSampler;
  537. ObjectName := lvSamplers.Selected.Caption;
  538. DeleteSampler(SelectedIndex, False);
  539. end;
  540. end;
  541. procedure TMainForm.Paste1Click(Sender: TObject);
  542. begin
  543. if Assigned(ClipBoardItem) then
  544. if ValidSelection then
  545. InsertSampler(SelectedIndex, ObjectName, ClipBoardItem)
  546. else
  547. InsertSampler(MaxInt, ObjectName, ClipBoardItem);
  548. end;
  549. procedure TMainForm.tbUpDownClick(Sender: TObject);
  550. var
  551. Index: Integer;
  552. S: TNestedSampler;
  553. ObjName: string;
  554. begin
  555. if ValidSelection then
  556. begin
  557. Index := SelectedIndex;
  558. S := SelectedSampler;
  559. ObjName := lvSamplers.Selected.Caption;
  560. DeleteSampler(Index, False);
  561. InsertSampler(Index + TComponent(Sender).Tag, ObjName, S);
  562. end;
  563. end;
  564. procedure TMainForm.AddSampler(Sampler: TNestedSampler);
  565. var
  566. NewItem: TListItem;
  567. begin
  568. if Sampler is TPatternSampler then
  569. with Sampler as TPatternSampler do
  570. Pattern := CreateJitteredPattern(10, 10, 3, 3);
  571. Samplers.Add(Sampler);
  572. Rasterizer.Sampler := Sampler;
  573. NewItem := lvSamplers.Items.Add;
  574. NewItem.Caption := NewInstanceName(Sampler);
  575. NewItem.SubItems.Add(Sampler.ClassName);
  576. NewItem.Data := Sampler;
  577. end;
  578. procedure TMainForm.InsertSampler(Index: Integer; ObjName: string; Sampler: TNestedSampler);
  579. var
  580. NewItem: TListItem;
  581. begin
  582. Index := Constrain(Index, 0, lvSamplers.Items.Count);
  583. if Index = lvSamplers.Items.Count then
  584. begin
  585. Samplers.Add(Sampler);
  586. Sampler.Sampler := LastSampler;
  587. Rasterizer.Sampler := Sampler;
  588. end
  589. else if Index >= 0 then
  590. begin
  591. TNestedSampler(Samplers[Index]).Sampler := Sampler;
  592. if Index = 0 then
  593. Sampler.Sampler := Source.Resampler
  594. else
  595. Sampler.Sampler := Samplers[Index - 1];
  596. Samplers.Insert(Index, Sampler);
  597. end;
  598. NewItem := lvSamplers.Items.Insert(Index);
  599. NewItem.Caption := ObjName;
  600. NewItem.SubItems.Add(Sampler.ClassName);
  601. NewItem.Data := Sampler;
  602. lvSamplers.Selected := NewItem;
  603. lvSamplers.Selected.Focused := True;
  604. end;
  605. procedure TMainForm.DeleteSampler(Index: Integer; FreeItem: Boolean);
  606. var
  607. S: TNestedSampler;
  608. begin
  609. if Index >= 0 then
  610. begin
  611. S := Samplers[Index];
  612. if Index < Samplers.Count - 1 then
  613. TNestedSampler(Samplers[Index + 1]).Sampler := S.Sampler
  614. else
  615. Rasterizer.Sampler := S.Sampler;
  616. Samplers.Delete(Index);
  617. if FreeItem and (Samplers.IndexOf(S) = -1) then
  618. S.Free;
  619. lvSamplers.Selected.Delete;
  620. PropertyEditor.SelectObject('', nil);
  621. end;
  622. end;
  623. procedure TMainForm.miRGBNoiseClick(Sender: TObject);
  624. begin
  625. AddSampler(TNoiseSampler.Create(LastSampler));
  626. end;
  627. procedure TMainForm.UpdateTransformations;
  628. var
  629. I: Integer;
  630. SrcRect: TRect;
  631. begin
  632. SrcRect := Source.BoundsRect;
  633. for I := 0 to Samplers.Count - 1 do
  634. if TPersistent(Samplers[I]) is TTransformer then
  635. TTransformer(Samplers[I]).Transformation.SrcRect := FloatRect(SrcRect);
  636. end;
  637. { TNoiseSampler }
  638. function TNoiseSampler.GetSampleFixed(X, Y: TFixed): TColor32;
  639. begin
  640. Result := Sampler.GetSampleFixed(X, Y);
  641. with TColor32Entry(Result) do
  642. begin
  643. R := Constrain(R + FRed + Random(FRedNoise), 0, 255);
  644. G := Constrain(G + FGreen + Random(FGreenNoise), 0, 255);
  645. B := Constrain(B + FBlue + Random(FBlueNoise), 0, 255);
  646. end;
  647. end;
  648. function TMainForm.NewInstanceName(Sampler: TNestedSampler): string;
  649. var
  650. S: string;
  651. I: Integer;
  652. begin
  653. S := Sampler.ClassName;
  654. S := Copy(S, 2, Length(S) - 1);
  655. for I := 1 to MaxInt do
  656. begin
  657. Result := S + IntToStr(I);
  658. if lvSamplers.FindCaption(0, Result, False, True, False) = nil then
  659. Exit;
  660. end;
  661. end;
  662. end.