fSimpleTexD.pas 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126
  1. unit fSimpleTexD;
  2. interface
  3. uses
  4. Winapi.Windows,
  5. Winapi.Messages,
  6. System.SysUtils,
  7. System.Variants,
  8. System.Classes,
  9. Vcl.Graphics,
  10. Vcl.Controls,
  11. Vcl.Forms,
  12. Vcl.Dialogs,
  13. Vcl.StdCtrls,
  14. GLScene.Utils,
  15. GLS.FilePGM,
  16. CUDA.Context,
  17. CUDA.APIComps,
  18. CUDA.Compiler,
  19. CUDA.Utility,
  20. GLS.Graphics,
  21. GLS.TextureFormat;
  22. type
  23. TForm1 = class(TForm)
  24. GLCUDA1: TGLCUDA;
  25. GLCUDADevice1: TGLCUDADevice;
  26. GLCUDACompiler1: TGLCUDACompiler;
  27. Button1: TButton;
  28. Memo1: TMemo;
  29. procedure Button1Click(Sender: TObject);
  30. procedure FormCreate(Sender: TObject);
  31. procedure FormDestroy(Sender: TObject);
  32. public
  33. MainModule: TCUDAModule;
  34. TurnPicture: TCUDAFunction;
  35. Image: TCUDATexture;
  36. TextureArray: TCUDAMemData;
  37. ResultData: TCUDAMemData;
  38. pgm: TGLPGMImage;
  39. Path: TFileName;
  40. procedure TurnPictureParameterSetup(Sender: TObject);
  41. end;
  42. TGLBitmap32 = TGLImage; // comment if supported Graphics32
  43. var
  44. Form1: TForm1;
  45. Angle : Single = 0.5; // angle to rotate image by (in radians)
  46. //-----------------------------------------
  47. implementation
  48. //-----------------------------------------
  49. {$R *.dfm}
  50. const
  51. TestFileName = 'lena_bw.pgm';
  52. OutFileName = 'lena_bw_out.pgm';
  53. procedure TForm1.FormCreate(Sender: TObject);
  54. begin
  55. Path := GetCurrentAssetPath();
  56. SetCurrentDir(Path + '\texture');
  57. pgm := TGLPGMImage.Create;
  58. end;
  59. procedure TForm1.Button1Click(Sender: TObject);
  60. var
  61. timer: Cardinal;
  62. bmp32: TGLBitmap32;
  63. begin
  64. pgm.LoadFromFile( TestFileName );
  65. if not InitCUTIL then
  66. begin
  67. Memo1.Lines.Add('Can''t load cutil32.dll');
  68. exit;
  69. end;
  70. bmp32 := TGLBitmap32.Create;
  71. bmp32.Assign( pgm );
  72. Memo1.Lines.Add(Format('File %s - loaded', [TestFileName]));
  73. TextureArray.CopyFrom( bmp32 ); // <- error
  74. Memo1.Lines.Add('Copied from host to device array');
  75. TurnPicture.Launch; // <- failed
  76. Memo1.Lines.Add('Warmup launch finished');
  77. cutCreateTimer( timer );
  78. cutStartTimer( timer );
  79. TurnPicture.Launch;
  80. cutStopTimer( timer );
  81. Memo1.Lines.Add('Launch finished');
  82. Memo1.Lines.Add(Format('Processing time: %f (ms)', [cutGetTimerValue( timer )] ));
  83. Memo1.Lines.Add(Format('%.2f Mpixels/sec',
  84. [(pgm.LevelWidth[0]*pgm.LevelHeight[0] / (cutGetTimerValue( timer) / 1000.0)) / 1e6]));
  85. cutDeleteTimer( timer );
  86. ResultData.CopyTo( bmp32 );
  87. Memo1.Lines.Add('Copied from device global memory to host');
  88. pgm.Assign( bmp32 );
  89. pgm.SaveToFile( OutFileName );
  90. Memo1.Lines.Add(Format('Saving result to %s - done', [OutFileName]));
  91. bmp32.Free;
  92. end;
  93. procedure TForm1.FormDestroy(Sender: TObject);
  94. begin
  95. pgm.Destroy;
  96. end;
  97. procedure TForm1.TurnPictureParameterSetup(Sender: TObject);
  98. begin
  99. with TurnPicture do
  100. begin
  101. SetParam(ResultData);
  102. SetParam(pgm.LevelWidth[0]);
  103. SetParam(pgm.LevelHeight[0]);
  104. SetParam(Angle);
  105. SetParam(Image);
  106. end;
  107. end;
  108. end.