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. GLS.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. TFormST = 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. FormST: TFormST;
  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 TFormST.FormCreate(Sender: TObject);
  54. begin
  55. Path := GetCurrentAssetPath();
  56. SetCurrentDir(Path + '\texture');
  57. pgm := TGLPGMImage.Create;
  58. end;
  59. procedure TFormST.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 TFormST.FormDestroy(Sender: TObject);
  94. begin
  95. pgm.Destroy;
  96. end;
  97. procedure TFormST.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.